#1
|
|||
|
|||
How do I implement my custom function in my VBA code?
In a workbook of mine there are 2 worksheets (Sheet1 & Sheet2) and Sheet1 has some data like (first image)
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: (to the right of the first image) Result Sheet2 data should look like: (last image) Note: I want to get the range to copy to & the range to paste dynamically and not hard code the ranges. I've done: Code:
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 Code:
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 |
#2
|
||||
|
||||
many ways, among them:
Code:
xx = netWT("3x(20x20 ml)") Range("A1").Value = netWT("3x(20x20 ml)") Range("A1").Value = netWT(Range("E4").Value) Attach a workbook so we can experiment. |
#3
|
|||
|
|||
Attached a sample workbook.
Note: I do not want to hard code the ranges like Code:
Range("A1").Value = netWT(Range("E4").Value) |
#4
|
||||
|
||||
A few options in the attached.
You can enable lines ending in 'debug line if you want to follow what's happening as you step through the code with F8 on the keyboard. You can move the source data anywhere on sheet1, you can move the headers any on Sheet2, in any order, separated by blank columns if you want, but they should be on the same row. Edit: I see that you've asked this question elsewhere (excel - Using a UDF in a VBA copy paste macro - Stack Overflow), you're really obliged to inform people of that. Have a read of Excelguru Help Site - A message to forum cross posters Get known as a cross-poster without supplying links and you'll find your responses drying up. ps. It would be nice if you acknowledge it when people try to help - nothing from you the last two times I tried here. |
#5
|
|||
|
|||
Quote:
Thanks for your reply. |
Thread Tools | |
Display Modes | |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
VBA code to save to individual files and skipif function | beefcake2000 | Mail Merge | 2 | 12-05-2017 03:19 AM |
Custom ribbon button or shortcut for a specific function | Nicobisgaard | Word | 6 | 04-22-2015 04:39 AM |
Custom fields used in the Compare Function | OTPM | Project | 3 | 03-02-2015 06:43 AM |
Custom formatting code - rounding problem | venkys4u | Excel | 1 | 08-14-2012 07:45 PM |
Change format of date when using Now function in VB code | Bondai | Excel Programming | 2 | 03-02-2012 05:09 PM |