How gather data from the middle of the sheet?

[mtbthepro]

Hello,
This code needs to locate the Department63's account total and transfer it to designated row in another sheet. The problem I am having is the macro not being able to locate Department63's account total which is located between Department 60 and 65. The macro can locate Dept 60 and 65's account total and transfer it but doesn't find account total for Dept63.

Account total is always in ColumnB and the data is always from Column D to H.

Sub NumberTrans_Dep60()Dim nlast As Long
Dim sht As Worksheet
Dim n As Integer


Sheets("Amanda").Activate
Set sht = ActiveWorkbook.ActiveSheet
nlast = Cells(Rows.Count, "B").End(xlUp).Row
                    
For n = nlast To 1 Step -1
If sht.Cells(n, 1).Value = "Department 60   Adult Program Department" Then
  ElseIf sht.Cells(n, 2).Value = "ACCOUNT TOTAL" Then
   Range(Cells(n, "D"), Cells(n, "H")).Copy
   Sheets("AR SUMMARY").Range("C19").PasteSpecial xlPasteValues


  End If
Next n
End Sub




Sub NumberTrans_Dep63()
Dim nlast As Long
Dim sht As Worksheet
Dim n As Integer


Sheets("Amanda").Activate
Set sht = ActiveWorkbook.ActiveSheet
nlast = Cells(Rows.Count, "B").End(xlUp).Row


For n = nlast To 1 Step -1
If sht.Cells(n, 1).Value = "Department 63   Writers'Voice NatlDept" Then
  ElseIf sht.Cells(n, 2).Value = "ACCOUNT TOTAL" Then
   Range(Cells(n, "D"), Cells(n, "H")).Copy
   Sheets("AR SUMMARY").Range("C20").PasteSpecial xlPasteValues


  End If
Next n
End Sub


Sub NumberTrans_Dep65()
Dim nlast As Long
Dim sht As Worksheet
Dim n As Integer


Sheets("Amanda").Activate
Set sht = ActiveWorkbook.ActiveSheet
nlast = Cells(Rows.Count, "B").End(xlUp).Row
For n = nlast To 1 Step -1
If sht.Cells(n, 1).Value = "Department 65   Visual and Performing Art" Then
  ElseIf sht.Cells(n, 2).Value = "ACCOUNT TOTAL" Then
   Range(Cells(n, "D"), Cells(n, "H")).Copy
   Sheets("AR SUMMARY").Range("C21").PasteSpecial xlPasteValues
  Exit For
  End If
Next n
End Sub

 

[mtbthepro]

Ok thanks.

Change module NumberTrans_Dep60 code to :-

Sub NumberTrans_Dep60()
Dim nlast As Long
Dim sht As Worksheet
Dim rng1 As Range
Dim rng2 As Range
Dim AcctTotRw As Long
Dim DeptRw As Long

Sheets("Amanda").Activate
Set sht = ActiveWorkbook.ActiveSheet
nlast = Cells(Rows.Count, "B").End(xlUp).Row
                    
'Find the Department head row
Range("A1").Activate
Set rng1 = Range("A1:A" & nlast).Find("Department 60 *", Cells(1, ActiveCell.Column), xlValues, xlWhole, , xlNext)
DeptRw = rng1.Row

'Find the Account Total Row for Department 60
Range("B" & DeptRw).Activate
Set rng2 = Range("B" & DeptRw & ":B" & nlast).Find("ACCOUNT TOTAL", Cells(DeptRw, ActiveCell.Column), xlValues, xlWhole, , xlNext)
AccTotRw = rng2.Row

Range("D" & AccTotRw),Resize(,5).Copy                                       ' Copy Columns D through H on the Account Totals row
Sheets("AR SUMMARY").Range("C19").PasteSpecial xlPasteValues   ' Paste as values on the "AR Summary" sheet

End Sub

If it works, change the other modules accordingly.

hth

Hi there,
The code works great! I just have one question, since the code doesn't read Department titles. How will it differentiate from let say
Department 23 Spring club
Department 23 Summer club

 

[ukmikeb]

Hi there,
The code works great! I just have one question, since the code doesn't read Department titles. How will it differentiate from let say
Department 23 Spring club
Department 23 Summer club

Your answer can be found in Post #6.

 

[mtbthepro]

Great thank you, so much.

 

[mtbthepro]

Hi there, if I run the macro in a sheet and it doesn't have at department in it then it stops. Should I add an IF statement with a condition like this,

Sub NumberTrans_Dep60()
Dim nlast As Long
Dim sht As Worksheet
Dim rng1 As Range
Dim rng2 As Range
Dim AcctTotRw As Long
Dim DeptRw As Long


Sheets("Amanda").Activate
Set sht = ActiveWorkbook.ActiveSheet
nlast = Cells(Rows.Count, "B").End(xlUp).Row

[COLOR=#b22222]
[B]IF DeptRw <> rng1.rw then
GoTo GoToHere
Elseif
[/B]                    [/COLOR]
Range("A1").Activate
Set rng1 = Range("A1:A" & nlast).Find("Department 60 ", Cells(1, ActiveCell.Column), xlValues, xlWhole, , xlNext)
DeptRw = rng1.Row


Range("B" & DeptRw).Activate
Set rng2 = Range("B" & DeptRw & ":B" & nlast).Find("ACCOUNT TOTAL", Cells(DeptRw, ActiveCell.Column), xlValues, xlWhole, , xlNext)
AccTotRw = rng2.Row


Range("D" & AccTotRw).Resize(, 5).Copy
Sheets("AR SUMMARY").Range("C35").PasteSpecial xlPasteValues
[COLOR=#b22222][B]End If

GoToHere:[/B][/COLOR]
NumberTrans_Dep63
End Sub

 

[ukmikeb]

Hi there, if I run the macro in a sheet and it doesn't have at department in it then it stops. Should I add an IF statement with a condition like this,

Sub NumberTrans_Dep60()
Dim nlast As Long
Dim sht As Worksheet
Dim rng1 As Range
Dim rng2 As Range
Dim AcctTotRw As Long
Dim DeptRw As Long


Sheets("Amanda").Activate
Set sht = ActiveWorkbook.ActiveSheet
nlast = Cells(Rows.Count, "B").End(xlUp).Row

[COLOR=#b22222]
[B]IF DeptRw <> rng1.rw then
GoTo GoToHere
Elseif
[/B]                    [/COLOR]
Range("A1").Activate
Set rng1 = Range("A1:A" & nlast).Find("Department 60 ", Cells(1, ActiveCell.Column), xlValues, xlWhole, , xlNext)
DeptRw = rng1.Row


Range("B" & DeptRw).Activate
Set rng2 = Range("B" & DeptRw & ":B" & nlast).Find("ACCOUNT TOTAL", Cells(DeptRw, ActiveCell.Column), xlValues, xlWhole, , xlNext)
AccTotRw = rng2.Row


Range("D" & AccTotRw).Resize(, 5).Copy
Sheets("AR SUMMARY").Range("C35").PasteSpecial xlPasteValues
[COLOR=#b22222][B]End If

GoToHere:[/B][/COLOR]
NumberTrans_Dep63
End Sub

No, not at all because your find statement seems to have changed from the one I suggested in Post #11

For the departments you have specified so far and using the table below :-
mtbthepro[TABLE="class: html-maker-worksheet"]
<thead>[TR]
[TH][/TH]
[TH]A[/TH]
[TH]B[/TH]
[/TR]
</thead><tbody>[TR]
[TH]1[/TH]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TH]2[/TH]
[TD]Department 23 Spring club[/TD]
[TD][/TD]
[/TR]
[TR]
[TH]3[/TH]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TH]4[/TH]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TH]5[/TH]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TH]6[/TH]
[TD][/TD]
[TD]ACCOUNT TOTAL[/TD]
[/TR]
[TR]
[TH]7[/TH]
[TD]Department 23 Summer club[/TD]
[TD][/TD]
[/TR]
[TR]
[TH]8[/TH]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TH]9[/TH]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TH]10[/TH]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TH]11[/TH]
[TD][/TD]
[TD]ACCOUNT TOTAL[/TD]
[/TR]
[TR]
[TH]12[/TH]
[TD]Department 60 Adult Program Department[/TD]
[TD][/TD]
[/TR]
[TR]
[TH]13[/TH]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TH]14[/TH]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TH]15[/TH]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TH]16[/TH]
[TD][/TD]
[TD]ACCOUNT TOTAL[/TD]
[/TR]
[TR]
[TH]17[/TH]
[TD]Department 63 Writers'Voice NatlDept[/TD]
[TD][/TD]
[/TR]
[TR]
[TH]18[/TH]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TH]19[/TH]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TH]20[/TH]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TH]21[/TH]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TH]22[/TH]
[TD][/TD]
[TD]ACCOUNT TOTAL[/TD]
[/TR]
[TR]
[TH]23[/TH]
[TD]Department 65 Visual and Performing Art[/TD]
[TD][/TD]
[/TR]
[TR]
[TH]24[/TH]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TH]25[/TH]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TH]26[/TH]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TH]27[/TH]
[TD][/TD]
[TD]ACCOUNT TOTAL[/TD]
[/TR]
</tbody>[/TABLE]
Excel 2007

the find statements for the respective departments will be :-

Set rng1 = Range("A1:A" & nlast).Find("Department 23 Spring club", Cells(1, ActiveCell.Column), xlValues, xlWhole, , xlNext)

Set rng1 = Range("A1:A" & nlast).Find("Department 23 Summer club", Cells(1, ActiveCell.Column), xlValues, xlWhole, , xlNext)

Set rng1 = Range("A1:A" & nlast).Find("Department 60 *", Cells(1, ActiveCell.Column), xlValues, xlWhole, , xlNext)

Set rng1 = Range("A1:A" & nlast).Find("Department 63 *", Cells(1, ActiveCell.Column), xlValues, xlWhole, , xlNext)

Set rng1 = Range("A1:A" & nlast).Find("Department 65 *", Cells(1, ActiveCell.Column), xlValues, xlWhole, , xlNext)

If I am interpreting the following comment :-

if I run the macro in a sheet and it doesn't have at department in it then it stops

correctly to mean that you have several workbooks/worksheets and you are not aware of the department content of each but still want to run an all encompassing macro then perhaps change the relevant section of code, in each macro, as follows :-

Range("A1").Activate
Set rng1 = Range("A1:A" & nlast).Find("Department 60 *", Cells(1, ActiveCell.Column), xlValues, xlWhole, , xlNext)

If Not rng1 is Nothing Then
    DeptRw = rng1.Row

    Range("B" & DeptRw).Activate
    Set rng2 = Range("B" & DeptRw & ":B" & nlast).Find("ACCOUNT TOTAL", Cells(DeptRw, ActiveCell.Column), xlValues, xlWhole, , xlNext)
    AccTotRw = rng2.Row

    Range("D" & AccTotRw).Resize(, 5).Copy
    Sheets("AR SUMMARY").Range("C19").PasteSpecial xlPasteValues
End If

hth

 

[mtbthepro]

Hi, I understand all of it thank you so much for the gracious help. Is it possible for me to contact you if I need help?

 

[mtbthepro]

I have made alot of changes to the code, so now it is not copying and pasting...

Sub NumberTrans_Dep65()
Dim nlast As Long
Dim sht As Worksheet
Dim rng1 As Range
Dim rng2 As Range
Dim AcctTotRw As Long
Dim DeptRw As Long


Sheets("Amanda").Activate
Set sht = ActiveWorkbook.ActiveSheet
nlast = Cells(Rows.Count, "B").End(xlUp).Row
clast = Cells(Rows.Count, "C").End(xlUp).Row
                    
Range("A1").Activate
Set rng1 = Range("A1:A" & nlast).Find("Department 65   Visual and Performing Art", Cells(1, ActiveCell.Column), xlValues, xlWhole, , xlNext)
If Not rng1 Is Nothing Then
DeptRw = rng1.Row


Range("C" & DeptRw).Activate
Set rng2 = Range("C" & DeptRw & ":C" & clast).Find("GRAND TOTAL", Cells(DeptRw, ActiveCell.Column), xlValues, xlWhole, , xlNext)
If Not rng2 Is Nothing Then
AccTotRw = rng2.Row




If AccToRw <> AccToRw Then
Range("B" & DeptRw).Activate
Set rng2 = Range("B" & DeptRw & ":B" & nlast).Find("ACCOUNT TOTAL", Cells(DeptRw, ActiveCell.Column), xlValues, xlWhole, , xlNext)
AccTotRw = rng2.Row
End If






Range("D" & AccTotRw).Resize(, 5).Copy
Sheets("AR SUMMARY").Range("C37").PasteSpecial xlPasteValues
End If
End If
End Sub

 

[ukmikeb]

Hi

It appears the goalposts are moving again!

Where has "Grand Total" come from?

What are you trying to do and what relationship has "Grand Total" to "Account Total".

Can they both exist for the same department?

When you run a module which is called by another module and you define a variable at the beginning of that module, that variable has the starting value of "" or zero.

If you call that module again the said variable will still have a value of " " or zero and any test like :-

If AccToRw <> AccToRw Then

will always fail.

Also, you may have that variable mis-spelt.

If you need further help and it is related to this thread then post the question in this thread. If it is not related to this thread then post it as a new topic and help will be forthcoming.

 

[mtbthepro]

Lol I am sorry, Grand total is found in the department if the department has multiple account totals. So the "grand total" is always in column C and always at the end of the department.

 

[ukmikeb]

Lol I am sorry, Grand total is found in the department if the department has multiple account totals. So the "grand total" is always in column C and always at the end of the department.

But that gives me no clues as to the rules you have when capturing the data.

Remember that only you can see the data you are working with and I only have a minds-eye picture based on what you have told me.

Perhaps if you can share your file (removing any sensitive information) on one of the file sharing sites I may be able to see what the objective is.

And maybe rather than have several modules all doing basically the same process you can combine it all in one module and use parameters to achieve your objective.