VBA for Countif from another sheet has dynamic range column header name. Summarize and Count the occurrences based on column name and sort descending

[Jonnathanjons]

0
I would like your help in solving a problem I am facing in a countif function from the main sheet "Head Quarters" to another sheets "Laboratory" and "Operations" based on the Columns in the main sheet. but column reference change every month but the name remains the same. so I cannot use column reference in Countif vba scripts. I like to have the their counts occurred in their respective sheets based on the occurrence in the main sheet . I created a vba script but cannot manage to find scripts to pull based on name in the last part of the code where it says " Set rng = ws.Range("AH2:AH" & lr)" I need your help here. Pls review this code and simplify this code if possible to achieve this results..Please note that reference in the main sheet cannot be to a specific column but can only based on column name as "Laboratory" or "Operations" because it keep changing every month. Please see the sample spreadsheet I created for this data and also the VB script I wrote.

Source Sheet as my input as below



Result should be like below and Descending order in their respective sheets.




'Please see the code. It create a new sheet Laboratory and Operations'

>>> use code - tags <<<

Sub List_Unique_Values()
Dim rSelection As Range
Dim qSelection As Range
Dim ws As Worksheet
Dim rng1 As Range
Dim rng2 As Range
ShtName = "Laboratory"
ShtName1 = "Operations"

Set ws = Sheets("Head Quarters")
'This will create a sheet 'Laboratory' and copy the data from main sheet and remove duplicate    
If Evaluate("isref('" & ShtName & "'!A1)") Then
'Application.CutCopyMode = False
GoTo Skip
Else
Worksheets("Head Quarters").Select
On Error Resume Next

Set rSelection = Rows("1:1").Find(ShtName, , xlValues, xlWhole, , , True)
rSelection.Range(Range("A1"), Range("A1").End(xlDown)).Copy
Set ws = Worksheets.add(After:=ActiveSheet)
ws.Name = "Laboratory"
End If

With ws.Range("A1")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
'.PasteSpecial xlPasteValuesAndNumberFormats
End With

'Remove duplicates
ws.UsedRange.RemoveDuplicates Columns:=1, Header:=xlYes

'Remove blank cells (optional)
On Error Resume Next
ws.UsedRange.SpecialCells(xlCellTypeBlanks).Delete Shift:=xlShiftUp

On Error GoTo 0
'Autofit column
ws.Columns("A").AutoFit
ws.Range("A1").Select

Skip:
Set ws = Sheets("Head Quarters")
Set ws1 = Sheets("Laboratory")
lr = ws.Cells(Cells.Rows.Count, rSelection.Column).End(xlUp).Row
lRow = ws1.Cells(Cells.Rows.Count, "A").End(xlUp).Row
lRow1 = ws1.Cells(Cells.Rows.Count, "B").End(xlUp).Row
Set rng = ws.Range("AH2:AH" & lr)                                                                           '<<<<<< I need help here to choose the range by column header name
'Set rng = ws.Range("AH2:lr" & lr)

With ws1
  .Range("A1").Copy .Range("B1")
  .Range("B1") = "Rows"
  .Range("B2:B" & lRow).Formula = "=COUNTIF('" & ws.Name & "'!" & rng.Address & ",A2)"
  .Range("B2:B" & lRow).Value = ws1.Range("B2:B" & lRow).Value

  ' ws1.Columns.AutoFit
  End With

  On Error Resume Next
  Set rng1 = ws1.Range(Range("A1"), Range("B1").End(xlDown))
  rng1.Sort key1:=Range("B1"), order1:=xlDescending, Header:=xlYes

  'Similarly create another sheet for 'Operations' and summarize and do countif based on column name

  End Sub

 

[p45cal]

change:
Set Rng = ws.Range("AH2:AH" & lr)
to:
Set Rng = rSelection.Offset(1).Resize(lr - 1)

 

[p45cal]

This sort of thing doesn't need vba, A pivot table or Power Query can give you those results.
Should you change the source data, the pivots/queries need refreshing. Both techniques rely on the column headers.

 

[Jonnathanjons]

This sort of thing doesn't need vba, A pivot table or Power Query can give you those results.
Should you change the source data, the pivots/queries need refreshing. Both techniques rely on the column headers.

Thats a genius at work. thanks much for taking time to review the code and the correction done. That solved my problem .
If I have to do the same for another column header "Operations" , Is there a a clever way of doing it by a loop or some other way rather than copying the codes again at the end changing the range values to do the same?

I created myself a line which just worked but I would like to get your opinion on this Can you please check
Set rng = ws.Range(rSelection, rSelection.End(xlDown)) if your time permits.
thanks again.

 

[p45cal]

Attached.

I created myself a line which just worked but I would like to get your opinion on this Can you please check
Set rng = ws.Range(rSelection, rSelection.End(xlDown)) if your time permits.

That's fine. It includes the top row but it shouldn't matter.

 

[Jonnathanjons]

Brilliant !!!! Thanks much. its very helpful.

 

[Jonnathanjons]

Hello p45cal

Can you please take a look at an issue I posted. I am sure this will not take much time of yours. I have already wrote most scripts but need your help in the last bit. Thanks a lot

VBA to concatenate based on Column header name

Hello Dear , Could you please help me in concatenating the columns based on Column name and not by specific range as the data keep changing every week. Result should be in the Column "Billing" This column should be created after last available column provided. This is the input file Result...

chandoo.org