Find and match header in different location for the column based on sheet name

O

Omar M

Board Regular
Joined
Jan 11, 2024
Messages
55
Office Version
  1. 2019
Platform
  1. Windows
Hello,
I would macro for search BALANCE word in different location for each sheet.
so the BALANCE column will not be in the same location for each sheet .
should extract date(today) in column A , sheet name in column B and the last amount is existed in BALANCE column for each sheet as I did in BALANCES sheet.
the data for each sheet will be more about 9000 rows for each sheet also I will add more new sheets before BALANCES sheet. so the macro should deal with sheets are just before BALANCES sheet .
OMRA.xlsm
ABCD
1DATEDEBITCREDITBALANCE
211/03/20241,000.001,000.00
312/03/20242,000.003,000.00
413/03/20241,000.002,000.00
514/03/2024500.002,500.00
615/03/2024100.002,600.00
716/03/2024600.002,000.00
8TOTAL3,600.001,600.002,000.00
OMAR
Cell Formulas
RangeFormula
B8:C8B8=SUM(B2:B7)
D8D8=B8-C8




OMRA.xlsm
ABCD
1DATEDEBITCREDITBALANCE
212/03/20241,000.00-1,000.00
313/03/20244,000.00-5,000.00
414/03/20241,000.00-6,000.00
514/03/20241,000.00-5,000.00
615/03/20243,000.00-2,000.00
7TOTAL4,000.006,000.00-2,000.00
OMRAN
Cell Formulas
RangeFormula
B7:C7B7=SUM(B2:B6)
D7D7=B7-C7



OMRA.xlsm
ABCDE
1ITEMIDQTYUNIT PRICEBALANCE
21ERT555200.001,200.00240,000.00
32ERT556890.00600.00534,000.00
43ERT557200.00120.0024,000.00
54ERT558100.00250.0025,000.00
65ERT559150.00300.0045,000.00
7TOTAL868,000.00
STOCK
Cell Formulas
RangeFormula
E2:E6E2=C2*D2
E7E7=SUM(E2:E6)



OMRA.xlsm
ABC
1ITEMDETAILSBALANCE
21SAFE200,000.00
32BANK1300,000.00
43BANK2400,000.00
5TOTAL900,000.00
SAFES
Cell Formulas
RangeFormula
C5C5=SUM(C2:C4)




OMRA.xlsm
ABC
1DATEDETAILESBALANCE
2
3
4
5
6
7
8
9
10
11
12
13
BALANCES



RESULT with create formatting and borders
OMRA.xlsm
ABC
1DATEDETAILESBALANCE
226/10/2024OMAR2,000.00
326/10/2024OMRAN-2,000.00
426/10/2024STOCK868,000.00
526/10/2024SAFES900,000.00
6TOTAL1,768,000.00
BALANCES
Cell Formulas
RangeFormula
C6C6=SUM(C2:C5)


I hope finding macro to do that.
thanks
 

Excel Facts

Why are there 1,048,576 rows in Excel?
The Excel team increased the size of the grid in 2007. There are 2^20 rows and 2^14 columns for a total of 17 billion cells.
Sort by date Sort by votes
Try:

VBA Code: 
Sub MakeBalance()
  Dim sh As Worksheet, shB As Worksheet
  Dim f As Range
  Dim lr As Long
  
  Application.ScreenUpdating = False
  Set shB = Sheets("BALANCE")
  shB.Range("A2:C" & Rows.Count).Clear
  
  For Each sh In Sheets
    If sh.Name <> shB.Name Then
      Set f = sh.Rows(1).Find("BALANCE", , xlValues, xlWhole, , , False)
      If Not f Is Nothing Then
        shB.Range("A" & Rows.Count).End(3)(2).Resize(1, 3).Value = _
          Array(Date, sh.Name, f.Cells(Rows.Count).End(3).Value)
      End If
    End If
  Next
  lr = shB.Range("A" & Rows.Count).End(3).Row + 1
  shB.Range("A" & lr).Resize(1, 3).Value = _
    Array("TOTAL", , "=SUM(C2:C" & lr - 1 & ")")
    
  shB.Range("A2:C" & lr).Borders.LineStyle = xlContinuous
  shB.Range("A" & lr).Font.Bold = True
  shB.Range("C:C").NumberFormat = "#,##0.00;-#,##0.00;0"
  Application.ScreenUpdating = True
End Sub

For the format of 0 in the BALANCE column, change "0.00" to the format you want, it can be:
shB.Range("C:C").NumberFormat = "#,##0.00;-#,##0.00;0"​
shB.Range("C:C").NumberFormat = "#,##0.00;-#,##0.00;-"​
shB.Range("C:C").NumberFormat = "#,##0.00;-#,##0.00;"​

;)
 
Last edited:
Upvote 0
Try this code.
VBA Code: 
Sub UpdateBalanceSheet()
Dim sh As Worksheet
Dim M, Lr&, Ro&
Application.ScreenUpdating = False
With Sheets("BALANCES")
.Range("A1").CurrentRegion.Clear
.Range("A1:C1") = Array("DATE", "DATAILS", "BALANCE")
End With
For Each sh In Worksheets
If sh.Name <> "BALANCES" Then
Lr = sh.Range("A" & Rows.Count).End(xlUp).Row
'S = sh.Name & "A2:A" & Lr
M = Filter(Evaluate("transpose(IF('" & sh.Name & "'!A2:A" & Lr & "=Today(),'" & sh.Name & "'!D2:D" & Lr & ",false))"), False, False)

If UBound(M) >= 0 Then
With Sheets("BALANCES")
Ro = .Range("A" & Rows.Count).End(xlUp).Row + 1
.Range("A" & Ro & ":A" & Ro + UBound(M)) = Date
.Range("B" & Ro & ":B" & Ro + UBound(M)) = sh.Name
.Range("C" & Ro & ":C" & Ro + UBound(M)) = WorksheetFunction.Transpose(M)
End With
End If
M = ""
End If
Next sh

With Sheets("BALANCES")
.Range("A" & Ro + 2) = "TOTAL"
.Range("C" & Ro + 2).Formula = "=Sum(C2:C" & Ro + 1 & ")"
.Range("A1").CurrentRegion.Borders.LineStyle = xlContinuous
End With

Application.ScreenUpdating = True
End Sub
 
Upvote 0
A small detail, the name of the sheet is "BALANCES".

Adjust this in the macro:

Set shB = Sheets("BALANCES")

Code complete:
VBA Code: 
Sub MakeBalance()
  Dim sh As Worksheet, shB As Worksheet
  Dim f As Range
  Dim lr As Long
  
  Application.ScreenUpdating = False
  Set shB = Sheets("BALANCES")
  shB.Range("A2:C" & Rows.Count).Clear
  
  For Each sh In Sheets
    If sh.Name <> shB.Name Then
      Set f = sh.Rows(1).Find("BALANCE", , xlValues, xlWhole, , , False)
      If Not f Is Nothing Then
        shB.Range("A" & Rows.Count).End(3)(2).Resize(1, 3).Value = _
          Array(Date, sh.Name, f.Cells(Rows.Count).End(3).Value)
      End If
    End If
  Next
  
  lr = shB.Range("A" & Rows.Count).End(3).Row + 1
  shB.Range("A" & lr).Resize(1, 3).Value = Array("TOTAL", , "=SUM(C2:C" & lr - 1 & ")")
  shB.Range("A2:C" & lr).Borders.LineStyle = xlContinuous
  shB.Range("A" & lr).Font.Bold = True
  shB.Range("C:C").NumberFormat = "#,##0.00;-#,##0.00;0"
  Application.ScreenUpdating = True
End Sub

😅
 
Upvote 0
Try. Modified code.
VBA Code: 
Sub UpdateBalanceSheet()
Dim sh As Worksheet
Dim M, Lr&, Ro&, S$
Application.ScreenUpdating = False
With Sheets("BALANCES")
.Range("A1").CurrentRegion.Clear
.Range("A1:C1") = Array("DATE", "DATAILS", "BALANCE")
End With
For Each sh In Worksheets
If sh.Name <> "BALANCES" Then
Lr = sh.Range("A" & Rows.Count).End(xlUp).Row
S = Left(sh.Cells.Find("BALANCE").Address, 2)
M = Filter(Evaluate("transpose(IF('" & sh.Name & "'!A2:A" & Lr & "=Today(),'" & sh.Name & "'!" & S & "2:" & S & Lr & ",false))"), False, False)

If UBound(M) >= 0 Then
With Sheets("BALANCES")
Ro = .Range("A" & Rows.Count).End(xlUp).Row + 1
.Range("A" & Ro & ":A" & Ro + UBound(M)) = Date
.Range("B" & Ro & ":B" & Ro + UBound(M)) = sh.Name
.Range("C" & Ro & ":C" & Ro + UBound(M)) = WorksheetFunction.Transpose(M)
End With
End If
M = ""
End If
Next sh

With Sheets("BALANCES")
.Range("A" & Ro + 2) = "TOTAL"
.Range("C" & Ro + 2).Formula = "=Sum(C2:C" & Ro + 1 & ")"
.Range("A1").CurrentRegion.Borders.LineStyle = xlContinuous
.Range("A1:C1").EntireColumn.AutoFit
End With

Application.ScreenUpdating = True
End Sub
 
Upvote 0
it's perfect , Dante!

but I said
so the macro should deal with sheets are just before BALANCES sheet
Click to expand...
meaning ignore any sheet after BALANCES sheet.so I don't want implementation after BALANCES sheet .
my you fix it ,please?
 
Last edited:
Upvote 0
Omar M said:
meaning ignore any sheet after BALANCES sheet
Click to expand...
In the future, it would be more precise if you commented that after that sheet there are more sheets. I can't guess everything.

Omar M said:
my you fix it ,please?
Click to expand...
Of course, try:

VBA Code: 
Sub MakeBalance()
  Dim sh As Worksheet, shB As Worksheet
  Dim f As Range
  Dim lr As Long
  
  Application.ScreenUpdating = False
  Set shB = Sheets("BALANCES")
  shB.Range("A2:C" & Rows.Count).Clear
  
  For Each sh In Sheets
    If sh.Name = shB.Name Then Exit For
    Set f = sh.Rows(1).Find("BALANCE", , xlValues, xlWhole, , , False)
    If Not f Is Nothing Then
      shB.Range("A" & Rows.Count).End(3)(2).Resize(1, 3).Value = _
        Array(Date, sh.Name, f.Cells(Rows.Count).End(3).Value)
    End If
  Next
  
  lr = shB.Range("A" & Rows.Count).End(3).Row + 1
  shB.Range("A" & lr).Resize(1, 3).Value = Array("TOTAL", , "=SUM(C2:C" & lr - 1 & ")")
  shB.Range("A2:C" & lr).Borders.LineStyle = xlContinuous
  shB.Range("A" & lr).Font.Bold = True
  shB.Range("C:C").NumberFormat = "#,##0.00;-#,##0.00;0"
  Application.ScreenUpdating = True
End Sub

😇
 
Upvote 0
Solution
You must log in or register to reply here.

Similar threads

A
  • Solved
Delete customer if contains the same amount otherwise just subtract between two sheets
2
Replies
15
Views
385
igold
igold
E
  • Solved
Find a value matching a range upon several criteria
Replies
2
Views
156
ED38
E
H
  • Question Question
Print out range for specific sheet based on two comboboxes on userform
Replies
1
Views
209
Hasson
H
L
  • Question Question
Macro to correct entries across multiple sheets
Replies
0
Views
81
Lux Aeterna
L
H
  • Solved
populate dynamic list in dropdown without duplicates items based on sheet name
Replies
3
Views
301
kevin9999
K

Forum statistics

Threads
1,223,060
Messages
6,169,860
Members
452,286
Latest member
noclue2000

Share this page

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
Back
Top