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

 

[ukmikeb]

Hi

If you find the other departments ok then that would suggest that the description "Department 63 Writers'Voice NatlDept" doesn't match with what you have on the worksheet.

You dim nlast as Long, why is n not dimmed as Long too?

hth

 

[mtbthepro]

Hi there, thanks for replay. Well, it does find it but since all three departments are on the same sheet, is it possible that the macro confuses Account total with the department below or top?
Because if I add exit for then it will go to the bottom department which is dept65 for the account total and if I don't add exit for then it will copy the account total in department60 which above it
nlast is as Long lol

 

[ukmikeb]

Hi

Try the following :-

Dim rng1 As Range
Dim rng2 As Range
Dim AcctTotRw As Long
Dim DeptRw As Long
Dim nlast As Long

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 the above Department
Range("B" & DeptRw).Activate
Set rng2 = Range("B" & DeptRw & ":B" & nlast).Find("ACCOUNT TOTAL", Cells(DeptRw, ActiveCell.Column), xlValues, xlWhole, , xlNext)
AccTotRw = rng2.Row

to find the head row for the Department and the respective "Account Total" row for the Department.

In the above I assume that you have matching pairs of Department and Total and you know that the Departments are present.

You can then use the value in AccTotRow to process the relevant data.

I think you missed the point I was making about defining variable n as Long. Fy,i if you define a variable that is reflecting the row position as Integer rather than Long if your data is greater than 35627 rows you will not capture all of your data.

hth

 

[mtbthepro]

Hi there, I made some changes to your code and it is giving me an error at the highlighted row.

Sheets("Amanda").Activate
Range("A1").Activate
Set rng1 = Range("A1:A" & nlast).Find("Department 63   Writers'Voice NatlDept *", Cells(1, ActiveCell.Column), xlValues, xlWhole, , xlNext)
[COLOR=#ff0000]DeptRw = rng1.Row[/COLOR]

 

[ukmikeb]

Hi there, I made some changes to your code and it is even me an error at the highlighted row.

Sheets("Amanda").Activate
Range("A1").Activate
Set rng1 = Range("A1:A" & nlast).Find("Department 63   Writers'Voice NatlDept *", Cells(1, ActiveCell.Column), xlValues, xlWhole, , xlNext)
[COLOR=#ff0000]DeptRw = rng1.Row[/COLOR]

Apologies, I should have told you that for the Department you only need to include all text up to and including the space after the department number and an asterisk, like :-

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

where nn is the department number.

If you have varying text for the SAME department number then use that without the asterisk.

hth

 

[mtbthepro]

Hi, I am sure I explained very well. There is no need to store Dept in DeptRw. The code is supposed to search for a certain Department and then go through the rows in column B until account total is found in column B. Then copy everything from column D to H in the account total row and paste it in the sheet AR summary.
My code works fine but doesn't work when there is department a between departments because then my code jumps to the account total either in the top department or bottom department.
EX:
Dep60
Dep63
Dep65
My code can find Department 63 perfectly but when it looks for the account total then it gets confusing because all three departments have account total in the same column. So it will read either Dept60 or Dept65 account total.
How can I modify the code so that when a certain department is found then the code will run through the rows below the department in column B to find the account total?

Yes, I understand that but I am still getting an error at the same line I highlighted in the last comment.

Also, how would I go about gather the data from the account total and transfer it to another sheet with this code?

 

[ukmikeb]

Can you clarify which of the following layouts represents your data :-

1, Layout 1

          ACC Total for Dep 60
Dep 60
           ACC Total for Dep 63
Dep 63
           ACC Total for Dep 65
Dep 65

or
2, Layout 2

Dep 60
           ACC Total for Dep 60
Dep 63
           ACC Total for Dep 63
Dep 65
           ACC Total for Dep 65

or something else.

The code I have given you removes the need for a loop but assumes that the data layout corresponds to Layout 2.

If the layout of the data conforms to Layout 1 can you confirm that the cell containing "ACCOUNT TOTAL" is in the row immediately above the account description for the Department.

 

[mtbthepro]

It is layout 2. The below chart is an example to what my data looks like. It from column A to H

[TABLE="width: 986"]
<tbody>[TR]
[TD="colspan: 3"]Department 63 Central Reservation[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="colspan: 2"]ACCOUNT#: 1-025-73-00000-3651[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]MEMBER NUMBER[/TD]
[TD]MEMBER NAME[/TD]
[TD]TRN DATE[/TD]
[TD]0 -30 DAYS[/TD]
[TD]31-60 DAYS[/TD]
[TD]61-90 DAYS[/TD]
[TD]OVER 90 DAYS[/TD]
[TD]PAST DUE[/TD]
[/TR]
[TR]
[TD]073-500001120-00[/TD]
[TD]Creative Tours US[/TD]
[TD="align: right"]1/9/2017[/TD]
[TD="align: right"]$0.00[/TD]
[TD="align: right"]$0.00[/TD]
[TD="align: right"]$0.00[/TD]
[TD="align: right"]$525.00[/TD]
[TD="align: right"]$525.00[/TD]
[/TR]
[TR]
[TD]073-500006794-00[/TD]
[TD]Dalhoff Travel 20[/TD]
[TD="align: right"]11/21/2016[/TD]
[TD="align: right"]$0.00[/TD]
[TD="align: right"]$0.00[/TD]
[TD="align: right"]$0.00[/TD]
[TD="align: right"]$784.00[/TD]
[TD="align: right"]$784.00[/TD]
[/TR]
[TR]
[TD]073-500006794-00[/TD]
[TD]Dalhoff Travel 20[/TD]
[TD="align: right"]11/21/2016[/TD]
[TD="align: right"]$0.00[/TD]
[TD="align: right"]$0.00[/TD]
[TD="align: right"]$0.00[/TD]
[TD="align: right"]$1,078.00[/TD]
[TD="align: right"]$1,078.00[/TD]
[/TR]
[TR]
[TD]073-500006794-00[/TD]
[TD]Dalhoff Travel 20[/TD]
[TD="align: right"]11/21/2016[/TD]
[TD="align: right"]$0.00[/TD]
[TD="align: right"]$0.00[/TD]
[TD="align: right"]$0.00[/TD]
[TD="align: right"]$462.00[/TD]
[TD="align: right"]$462.00[/TD]
[/TR]
[TR]
[TD]073-500002487-00[/TD]
[TD]Dwight School[/TD]
[TD="align: right"]1/7/2017[/TD]
[TD="align: right"]$0.00[/TD]
[TD="align: right"]$0.00[/TD]
[TD="align: right"]$0.00[/TD]
[TD="align: right"]$295.00[/TD]
[TD="align: right"]$295.00[/TD]
[/TR]
[TR]
[TD]026-500067920-00[/TD]
[TD]Indiana Univ. of[/TD]
[TD="align: right"]1/27/2017[/TD]
[TD="align: right"]$0.00[/TD]
[TD="align: right"]$0.00[/TD]
[TD="align: right"]$0.00[/TD]
[TD="align: right"]$323.00[/TD]
[TD="align: right"]$323.00[/TD]
[/TR]
[TR]
[TD]073-500015034-00[/TD]
[TD]Les Adventures Ma[/TD]
[TD="align: right"]1/23/2017[/TD]
[TD="align: right"]$0.00[/TD]
[TD="align: right"]$0.00[/TD]
[TD="align: right"]$0.00[/TD]
[TD="align: right"]$533.00[/TD]
[TD="align: right"]$533.00[/TD]
[/TR]
[TR]
[TD]073-500001980-00[/TD]
[TD]Unique Reisen[/TD]
[TD="align: right"]12/27/2016[/TD]
[TD="align: right"]$0.00[/TD]
[TD="align: right"]$0.00[/TD]
[TD="align: right"]$0.00[/TD]
[TD="align: right"]$436.00[/TD]
[TD="align: right"]$436.00[/TD]
[/TR]
[TR]
[TD]090-500000294-00[/TD]
[TD]Vip Voyages[/TD]
[TD="align: right"]12/28/2016[/TD]
[TD="align: right"]$0.00[/TD]
[TD="align: right"]$0.00[/TD]
[TD="align: right"]$0.00[/TD]
[TD="align: right"]$295.00[/TD]
[TD="align: right"]$295.00[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]ACCOUNT TOTAL[/TD]
[TD][/TD]
[TD="align: right"]$0.00[/TD]
[TD="align: right"]$0.00[/TD]
[TD="align: right"]$0.00[/TD]
[TD="align: right"]$4,731.00[/TD]
[TD="align: right"]$4,731.00[/TD]
[/TR]
</tbody>[/TABLE]

 

[ukmikeb]

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