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!
Code
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