Vba code advice- ignore header row

VBA learner ITG

Board Regular
Joined
Apr 18, 2017
Messages
197
Office Version
  1. 365
Hi all,

I hope i could get your guidance.

I am stumped to which line of the code needs amending or adding in as currently, it copies the header row into the data set if the column is blank.

What I am trying to achieve is to ignore the header row.

I have tried different variances to the code and I am stumped and seeking advice!


Code:
Sub copyDataBlocks2()
Dim intErrCount As Integer


' create worksheet objects
Dim shtSource As Worksheet: Set shtSource = Sheets("ws2")
Dim shtTarget As Worksheet: Set shtTarget = Sheets("ws1")


' create range objects
Dim rngSourceHeaders As Range: Set rngSourceHeaders = shtSource.Range("A1:LL1")


With shtTarget
    Dim rngTargetHeaders As Range: Set rngTargetHeaders = .Range("A1:LL1") '.Cells(1, 1), .Cells(1, .Columns.Count).End(xlToLeft)) 'Or just .Range("A1:LL1")
    Dim rngPastePoint As Range: Set rngPastePoint = .Cells(.Rows.Count, 1).End(xlUp).Offset(1 + 1) 'Shoots up from the bottom of the sheet untill it bumps into something and steps one down
End With


Dim rngDataColumn As Range


' process data
Dim cl As Range, i As Integer
For Each cl In rngTargetHeaders ' loop through each cell in target header row
    
    ' identify source location
    i = 0 ' reset I
    On Error Resume Next ' ignore errors, these are where the value can't be found and will be tested later
        i = Application.Match(cl.Value, rngSourceHeaders, 0) 'Finds the matching column name
    On Error GoTo 0 ' switch error handling back off
    
    ' report if source location not found
    If i = 0 Then
        intErrCount = intErrCount + 1
        Debug.Print "unable to locate item [" & cl.Value & "] at " & cl.Address ' this reports to Immediate Window (Ctrl + G to view)
        GoTo nextCL
    End If
    
    ' create source data range object
    With rngSourceHeaders.Cells(1, i)
        Set rngDataColumn = Range(.Cells(2, 1), .Cells(1000000, 1).End(xlUp))
    End With
    
    ' pass to target range object
    cl.Offset(1, 0).Resize(rngDataColumn.Rows.Count, rngDataColumn.Columns.Count).Value = rngDataColumn.Value
    
nextCL:
Next cl


' confirm process completion and issue any warnings
If intErrCount = 0 Then
    MsgBox "process completed", vbInformation
Else
    MsgBox "WARNING: " & intErrCount & " issues encountered. Check VBA log for details", vbExclamation
End If
End Sub
 

Some videos you may like

Excel Facts

Excel Can Read to You
Customize Quick Access Toolbar. From All Commands, add Speak Cells or Speak Cells on Enter to QAT. Select cells. Press Speak Cells.

tlowry

Well-known Member
Joined
Nov 3, 2011
Messages
1,367
Here is some code that deals with getting non-header range. I admit that I did not review your code. If I misunderstood, then try again with samples. What does your code do if there are 5 rows in the header?

RemoveHeaders
is a function that returns a range without headers.

Code:
Sub main()
    Dim dat As Range
    Set dat = RemoveHeaders(Selection)
    dat.Select
End Sub
Function RemoveHeaders(rng As Range) As Range
    Dim dat
    Set dat = rng.Offset(rng.[B][COLOR=#0000ff]ListHeaderRows[/COLOR][/B], 0)
    Set RemoveHeaders = dat.Resize(dat.Rows.Count - rng.ListHeaderRows, dat.Columns.Count)
End Function
 

Watch MrExcel Video

Forum statistics

Threads
1,109,492
Messages
5,529,173
Members
409,854
Latest member
rickcoba
Top