Help me with the VBA Code

thedeadzeds

Active Member
Joined
Aug 16, 2011
Messages
361
Office Version
  1. 365
Platform
  1. Windows
Hi Guys,

I have the following code which works great. It essentially finds the column name from the data tab and copies the data to the New Tab. Is there a way to create a message if for some reason the column names are not found in the data tab? So if any of the column headers are not found, end the code with a message. FYI, this is just a snippet of the code, at some point i will need to create for about 15 column headers.

Many thanks


VBA Code:
Sub New()

If MsgBox("Are you sure you want to run VBA?", vbYesNo) = vbNo Then Exit Sub

Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Data") '<== Sheet that has raw data
Dim LRow As Long, Found As Range
Dim lastRow As String
Dim lastRow2 As String
lastRow = Sheets("New").Cells(Rows.Count, "A").End(xlUp).Row
lastRow2 = Sheets("New").Cells(Rows.Count, "B").End(xlUp).Row


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

' Dealership
Set Found = ws.Range("A1:KG1").Find("Dealership") '<== Header name to search for
If Not Found Is Nothing Then
LRow = ws.Cells(ws.Rows.Count, Found.Column).End(xlUp).Row
ws.Range(ws.Cells(2, Found.Column), ws.Cells(LRow, Found.Column)).Copy
Sheets("New").Range("A" & lastRow + 1).PasteSpecial xlPasteValues '<== Sheet to paste data
End If

ws.Activate
ActiveSheet.Select

' Date
Set Found = ws.Range("A1:KG1").Find("OrderDate") '<== Header name to search for
If Not Found Is Nothing Then
LRow = ws.Cells(ws.Rows.Count, Found.Column).End(xlUp).Row
ws.Range(ws.Cells(2, Found.Column), ws.Cells(LRow, Found.Column)).Copy
Sheets("New").Range("B" & lastRow + 1).PasteSpecial xlPasteValues '<== Sheet to paste data
End If

ws.Activate
ActiveSheet.Select



End Sub
 

Excel Facts

Enter current date or time
Ctrl+: enters current time. Ctrl+; enters current date. Use Ctrl+: Ctrl+; Enter for current date & time.

Joe4

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
59,551
Office Version
  1. 365
Platform
  1. Windows
You could change this:
VBA Code:
Set Found = ws.Range("A1:KG1").Find("Dealership") '<== Header name to search for
If Not Found Is Nothing Then
LRow = ws.Cells(ws.Rows.Count, Found.Column).End(xlUp).Row
ws.Range(ws.Cells(2, Found.Column), ws.Cells(LRow, Found.Column)).Copy
Sheets("New").Range("A" & lastRow + 1).PasteSpecial xlPasteValues '<== Sheet to paste data
End If
to something like this:
VBA Code:
Set Found = ws.Range("A1:KG1").Find("Dealership") '<== Header name to search for
If Found Is Nothing Then
    MsgBox "Cannot find Dealership", vbOkOnly, "ERROR!"
    Exit Sub
Else
    LRow = ws.Cells(ws.Rows.Count, Found.Column).End(xlUp).Row
    ws.Range(ws.Cells(2, Found.Column), ws.Cells(LRow, Found.Column)).Copy
    Sheets("New").Range("A" & lastRow + 1).PasteSpecial xlPasteValues '<== Sheet to paste data
End If
 

thedeadzeds

Active Member
Joined
Aug 16, 2011
Messages
361
Office Version
  1. 365
Platform
  1. Windows
That works thanks for your help but i was wondering if there was a way to check the column header names before the other code is run. So check if the coulmn header names exisit, if they do run the code, if they do not message saying which ones are not found.
 

Joe4

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
59,551
Office Version
  1. 365
Platform
  1. Windows
You can use an array to store all the headers that you want to look for, and loop through them to see if they exist at the beginning of your code.
That would look something like this:
VBA Code:
Dim Found
Dim hdrs()
Dim i As Long
Dim missing As String
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Data") '<== Sheet that has raw data

'Store array of headers to look for
hdrs = Array("Dealership", "OrderDate")

'Loop through array of headers to look for in row 1
For i = LBound(hdrs) To UBound(hdrs)
    Set Found = ws.Range("A1:KG1").Find(hdrs(i)) '<== Header name to search for
'   If header is not found, add it to the "missing" list
    If Found Is Nothing Then
        missing = missing & hdrs(i) & ", "
    End If
Next i

'Check to see if there are any missing headers
If Len(missing) > 0 Then
    MsgBox "Missing headers " & Left(missing, Len(missing) - 2), vbOKOnly, "MACRO CANCELLED!"
    Exit Sub
End If
You would just update your "hdrs" array and add the other headers that you want to look for.
 
Solution

Joe4

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
59,551
Office Version
  1. 365
Platform
  1. Windows
You are welcome.
 

Forum statistics

Threads
1,144,676
Messages
5,725,723
Members
422,636
Latest member
GatorsBucs

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top