Hi all, I need some help with the following:
- I need a VBA macro that will essentially go into a specific tab, namely 'Data - current month', and look for specific words within Column E ("Classification")
- The specific word is: 'BBBB / BBB'
- I then need the macro to copy the values in column D (Company Name) and Column L (Amount) for that associated row that contained the word 'BBBB' in Column E
- The macro must paste that into a different tab, namely 'Extended' into specific cells i.e. in columns G and H accordingly, starting from row 2 (i.e. not to paste over the headings in row 1)
- I need this process to be repeated for three different arrays of words. The first mentioned above being BBBB (to be copied into Columns G and H in the 'Extended' tab as above). The second array of words would be: 'GGGG - Specific', to be pasted into columns J and K in the 'Extended' tab
- The last array of words would be: 'BBBB Total' and 'BBBB Other' (i.e. search for both within the column), to be pasted into Columns N and O in the 'Extended' tab
I have the below code, but when I tried to tweak it (i.e. with relevant tab names, array word names etc.) it did not do anything really. Is someone able to help with this, pleaasE?
Many thanks in advance!
Sub TextBox1_Click() Dim rCell As Range, lReply As Long, firstaddress As String, intX As Integer Dim rCopyRange As Range, asArray As Variant, sData As String asArray = Array("BBBB / BBB") Application.ScreenUpdating = False For intX = LBound(asArray) To UBound(asArray) With Sheet1 sData = asArray(intX) On Error Resume Next Set rCell = .Columns(5).Find(What:=sData, After:=.Range("E1"), LookIn:=xlValues) If Not rCell Is Nothing Then firstaddress = rCell.Address Rows(rCell.Row).Activate Do rCell.EntireRow.Copy Destination:=Sheet2.Range("A65536").End(xlUp)(2) Set rCell = ws.Columns(6).FindNext(rCell) Loop While Not rCell Is Nothing And rCell.Address <> firstaddress And rCell.Row > 1 End If End With On Error GoTo 0 Next Application.ScreenUpdating = True End Sub