Using a UDF in a VBA copy paste macro

Question

In a workbook of mine there are 2 worksheets (Sheet1 & Sheet2) and Sheet1 has some data like

I'm trying to copy the data from columns SERIAL NO., HS CODE and PALLET MMT to Sheet2's columns PROD. ID, HS CODE & NET WT. respectively. Now the first two copies are pretty straight forward but the problem I'm having is generating NET WT. (it is the product of two numbers inside the brackets & divided by 1000)

Default Sheet2 looks like:

Result Sheet2 data should look like:

I've done:

Sub Macro1()
'
' Macro1 Macro
'

'
    Cells.Find(What:="SERIAL", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
    ActiveCell.Offset(1, 0).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("Sheet2").Select
    Cells.Find(What:="PROD", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
    Range("B4").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Sheets("Sheet1").Select
    Range("A1").Select
    Cells.Find(What:="CODE", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
    ActiveCell.Offset(1, 0).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("Sheet2").Select
    Range("C4").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
' @@@@@@@@@@ NET WT. ?????? @@@@@@@@@@@@@
End Sub

I've also made a function to calculate NET WT. & but struggling to figure out how to use it in my code without making it too complicated

Function netWT(CellRef As String)
    Dim i As Long, Result As String, ch As String
    For i = 1 To Len(CellRef)
        ch = Mid(CellRef, i, 1)
        Result = Result & IIf(ch Like "[0-9]", ch, " ")
    Next i
    Result = Application.Trim(Result)
    netWT = (Split(Result, " ")(1) * Split(Result, " ")(2)) / 1000
End Function

Help please. Different approach than mine are also welcome...It just has to do the job efficiently.

[This may help](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba) you to clean up your code a bit — Miles Fett, Dec 04 '19 at 17:14
Copy/pasting ranges is not recommended. Assign the values from one range to another using (e.g.) `Sheets("sheet2").range("A1:A10).value = Sheets("sheet1").range("B1:B10).value` — MBB70, Dec 04 '19 at 21:36

MBB70 · Answer 1 · 2019-12-05T17:18:59.957

0

This should do it...adjust ranges as required.

Sub PopulateNetWeightColumn()
    Sheets("Sheet2").Activate
    Range("C4").Select
    While Range("C" & ActiveCell.Row) <> ""
        Range("E" & ActiveCell.Row) = CalculateNetWeight(WorksheetFunction.VLookup(Range("C" & ActiveCell.Row), Sheets("Sheet1").Range("B3:G12"), 4, False))
        ActiveCell.Offset(1, 0).Select
    Wend
End Sub
Function CalculateNetWeight(palletString)
    Dim mult_1, mult_2
    palletString = Mid(palletString, InStr(palletString, "(") + 1, 100)
    palletString = Trim(Replace(Replace(Replace(palletString, " ml", ""), " gm", ""), ")", ""))
    mult_1 = CLng(Left(palletString, InStr(palletString, "x") - 1))
    mult_2 = CLng(Replace(palletString, mult_1 & "x", ""))
    CalculateNetWeight = (mult_1 * mult_2) / 1000
End Function

edited Dec 05 '19 at 17:18

answered Dec 04 '19 at 21:26

MBB70

375
2
16

I would use worksheetfunction.vlookup to find the associated Prod ID or HS Code and then pass that string resulting from the vlookup into the function to return the net weight next to the corresponding row. – MBB70 Dec 04 '19 at 21:42
index/match for HS code, since that field is to the right of the pallet field. – MBB70 Dec 04 '19 at 21:45
So `Sheets("Sheet2").Range("D4") = CalculateNetWeight(worksheetfunction.vlookup(Sheets("Sheet2").Range("B4"),Sheets("Sheet1").Range("B:G"),4,False))`...loop through list as required to process all. – MBB70 Dec 04 '19 at 22:07
how can I do this dynamically without manually writing the range? also how do I loop through your function dynamically without doing a fill down of the formula? – Tamal Banerjee Dec 05 '19 at 13:33

Using a UDF in a VBA copy paste macro

1 Answers1