Can get to final column

K

kbarton

New Member
Joined
Dec 1, 2008
Messages
23
Hi

I am having problems with some code finding the last column in a set of data. Currently the coding below takes me to the one before the last column, I'm not sure why, but the 'Resize(, Col) seems to be the culprit.

Does anyone have any ideas how to get this so that it will find the last column in a set of data?

With Sheets("Total_Sheets")
.Range("A1").Resize(, 3) = Array("Date", "Account", "Details")
Set Rng = .Range(.Range("A2"), .Range("A" & Rows.Count).End(xlUp)).Resize(, Col)

Many thanks for any answers.

Regards

Kev
 

Excel Facts

Save Often
If you start asking yourself if now is a good time to save your Excel workbook, the answer is Yes
Sort by date Sort by votes
How is Col defined?

This will find the last used column on the sheet
Code: 
Col = .Cells.Find("*", , , , xlByColumns, xlPrevious).Column
 
Upvote 0
Hi AlphaFrog

Many thanks for taking the time to reply. Here is the full coding supplied by MickG.

Sub MG03Jul47()
Dim Dn As Range
Dim Ws As Worksheet
Dim sht As Worksheet
Dim nRng As Range
Dim nnRng As Range
Dim Col As Integer
Dim Rng As Range
Dim c As Integer
Dim Lst As Long
Dim PstRng As Range
On Error Resume Next
If Sheets("Total_Sheets").Select = False Then
Sheets.Add(after:=Sheets(Sheets.Count)).Name = "Total_Sheets"
End If
On Error GoTo 0
Col = 0
With Sheets("Total_Sheets")
.Cells.ClearContents
.Cells.Interior.ColorIndex = xlNone
.Cells.Borders.LineStyle = xlContinuous
End With
For Each Ws In Worksheets

If Not Ws.Name = "Total_Sheets" And Not Ws.Name = "T_Sheets" Then

With Ws
Set Rng = .Range(.Range("A1"), .Range("A" & Rows.Count).End(xlUp))
End With
For Each Dn In Rng
c = c + 1
If IsDate(Dn) Then Exit For
Next Dn
With Sheets("Total_Sheets")
Lst = .Range("A" & .Rows.Count).End(xlUp).Offset(1).Row
Set nRng = Rng.Offset(c - 1).Resize(Rng.Count - c + 1, 3)
nRng.Copy .Range("A" & Lst).Resize(nRng.Rows.Count, 3)
Set nnRng = Rng.Offset(c - 1, 3).Resize(Rng.Count - c + 1, 2)
Set PstRng = .Range("D" & Lst).Offset(, Col).Resize(nnRng.Rows.Count, 2)
.Cells(1, PstRng.Column) = "Debits " & Split(Ws.Name, " ")(1)
.Cells(1, PstRng.Column + 1) = "Credits " & Split(Ws.Name, " ")(1)
nnRng.Copy PstRng
End With
End If
Col = Col + 2
c = 0
Next Ws
With Sheets("Total_Sheets")
.Range("A1").Resize(, 3) = Array("Date", "Account", "Details")
Set Rng = .Range(.Range("A2"), .Range("A" & Rows.Count).End(xlUp)).Resize(, Col)
MsgBox Rng.Address 'Delete as required
With Rng.Borders
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 56
End With
Rng.Sort .Range("A2"), xlAscending
.Rows(1).Columns.AutoFit
Rng.Resize(, 3).Columns.AutoFit
End With
Call cula(Rng.Resize(, 1))
MsgBox "Run!!"
End Sub


I don't know why but it takes me to the one before the last column for some reason? Mick has very kindly given up most of his Sunday to help on this so I'm very grateful to him. If I change the Column +2 to Column + 3 is seems to solve it, but puts additional blank columns in the sheet. Any ideas why the range is not going to the end column?

Many thanks for helping. Here is a link to the sample data if it makes it clearer? http://cl.ly/1l1M0q0p1y0f023Y3N0s

Regards

Kev
 
Last edited:
Upvote 0
Add the red + 1

Code: 
Col = Col + 2
c = 0
Next Ws
With Sheets("Total_Sheets")
.Range("A1").Resize(, 3) = Array("Date", "Account", "Details")
Set Rng = .Range(.Range("A2"), .Range("A" & Rows.Count).End(xlUp)).Resize(, Col [COLOR="Red"]+ 1[/COLOR])
MsgBox Rng.Address 'Delete as required
 
Upvote 0
That fixed it. Thank you very much AlphaFrog. I'm still amazed that there are people like you and MickG giving their time and expertise freely, it restores a lot of faith in the world. Your help will do a lot of good, and save time and taxpayers money, so I'm truly grateful.

Regards

Kev
 
Upvote 0
Thanks AlphaFrog & MickG - reworked coding

By a sequence of trial and error, from MickG's original coding, I've managed to get the code working with the new headers to take in the standard format we receive the bank statements in. It run through a few hundred pages of bank statements putting them in the right order ok. However, being a novice at this, would you be able to have a look and see if it contains errors that you can see if at all possible?

It would be useful to have the Row Headers in Bold and centred, ideally if that's at all possible? I can send through some sample/made up data if you need to run it through?

Sub MG03Jul47()
Dim Dn As Range
Dim Ws As Worksheet
Dim sht As Worksheet
Dim nRng As Range
Dim nnRng As Range
Dim Col As Integer
Dim Rng As Range
Dim c As Integer
Dim Lst As Long
Dim PstRng As Range
On Error Resume Next
If Sheets("Total_Sheets").Select = False Then
Sheets.Add(after:=Sheets(Sheets.Count)).Name = "Total_Sheets"
End If
On Error GoTo 0
Col = 0
With Sheets("Total_Sheets")
.Cells.ClearContents
.Cells.Interior.ColorIndex = xlNone
.Cells.Borders.LineStyle = xlContinuous
End With
For Each Ws In Worksheets

If Not Ws.Name = "Total_Sheets" And Not Ws.Name = "T_Sheets" Then

With Ws
Set Rng = .Range(.Range("A1"), .Range("A" & Rows.Count).End(xlUp))
End With
For Each Dn In Rng
c = c + 1
If IsNumeric(Dn) Then Exit For
Next Dn
With Sheets("Total_Sheets")
Lst = .Range("A" & .Rows.Count).End(xlUp).Offset(1).Row
Set nRng = Rng.Offset(c - 1).Resize(Rng.Count - c + 1, 7)
nRng.Copy .Range("A" & Lst).Resize(nRng.Rows.Count, 7)
Set nnRng = Rng.Offset(c - 1, 7).Resize(Rng.Count - c + 1, 2)
Set PstRng = .Range("H" & Lst).Offset(, Col).Resize(nnRng.Rows.Count, 2)
.Cells(1, PstRng.Column) = "Debits " & Split(Ws.Name, " ")(1)
.Cells(1, PstRng.Column + 1) = "Credits " & Split(Ws.Name, " ")(1)
nnRng.Copy PstRng
End With
End If
Col = Col + 2
c = 0
Next Ws
With Sheets("Total_Sheets")
.Range("A1").Resize(, 7) = Array("Index", "Account Name", "Account Number", "Sort Code", "Date", "Type", "Description")
Set Rng = .Range(.Range("A2"), .Range("A" & Rows.Count).End(xlUp)).Resize(, Col + 5)
MsgBox Rng.Address 'Delete as required
With Rng.Borders
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 56
End With
Rng.Sort .Range("E2"), xlAscending
Set Rng = .Range(.Range("A1"), .Range("A" & Rows.Count).End(xlUp))
.Rows(1).Columns.AutoFit
Rng.Resize(, 40).Columns.AutoFit
End With
Call cula(Rng.Resize(, 1))
MsgBox "Run!!"
End Sub
Sub cula(R As Range)
Dim Col As Variant
Dim Dn As Range
Dim c As Integer
Dim K As Variant
Col = Array(34, 35)
With CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare

For Each Dn In R
If Not .Exists(Dn.Value) Then
.Add Dn.Value, Dn
Else
Set .Item(Dn.Value) = Union(.Item(Dn.Value), Dn)
End If
Next
c = 0
For Each K In .keys
If .Item(K).Count > 1 Then
c = IIf(c = 2, 0, c)
.Item(K).EntireRow.Interior.ColorIndex = Col(c)
c = c + 1
End If
Next K
End With
End Sub

Regards

Kev
 
Upvote 0
Forum Tip: Pasting VBA code in the forum editor
It would be best if you surround your VBA code with code tags e.g [CODE]your VBA code here[/CODE]
It makes reading your VBA code much easier. When you're in the forum editor, highlight your pasted VBA code and then click on the icon with the pound or number sign #.

The code below will Bold and Center row 1 on Sheet "Total_Sheets". Most of the code was obtained with the macro recorder and then modified slightly.

Code: 
    With Sheets("Total_Sheets").Rows("1:1")
        .Font.Bold = True
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
 
Upvote 0
Sorry AlphaFrog. Thanks once again for your help.

My 'last' request if you have time is for this sub routine to colour the row if the dates are the same, but the account number is different. When MickG did this it would highlight where the first column was the date, now it's the 5th Column and the account number is the 3rd column.

Code: 
 Call cula(Rng.Resize(, 1))
MsgBox "Run!!"
End Sub
Sub cula(R As Range)
Dim Col As Variant
Dim Dn As Range
Dim c As Date
Dim K As Variant
Col = Array(34, 35)
    With CreateObject("scripting.dictionary")
    .CompareMode = vbTextCompare
       
        For Each Dn In R
            If Not .Exists(Dn.Value) Then
                .Add Dn.Value, Dn
            Else
                Set .Item(Dn.Value) = Union(.Item(Dn.Value), Dn)
            End If
        Next
    c = 0
        For Each K In .keys
            If .Item(K).Count > 1 Then
                c = IIf(c = 2, 0, c)
               .Item(K).EntireRow.Interior.ColorIndex = Col(c)
                c = c + 1
            End If
        Next K
End With
End Sub

Hope that came out ok? Thanks again.

Kev
 
Upvote 0
As best I can tell, cula colors rows only by Date irregardless of Account.

Change the line in MG03Jul47
Call cula(Rng.Resize(, 1))

To this...
Call cula(Rng.Resize(, 1).Offset(, 4))
 
Upvote 0
That worked perfectly. Many thanks.

Is there a way to get the transactions for the same day on one row? The header for the column identifies the account from the worksheet tab so the column with the account number is redundant really?

That is a tough ask I know, but any help would be very useful.

Regards

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

Similar threads

M
  • Solved
vba to sum up each column for each employee on column (A)
Replies
6
Views
330
kvsrinivasamurthy
K
montecarlo2012
  • Question Question
change display from horizontal to vertical
Replies
2
Views
134
montecarlo2012
montecarlo2012
Guinaba
  • Question Question
Tunning a VBA macro
Replies
1
Views
103
Skyybot
Skyybot
B
  • Solved
changing date format
Replies
5
Views
185
NoSparks
N
M
  • Solved
Deleting rows from a Range variable
Replies
4
Views
298
Umma123
U

Forum statistics

Threads
1,224,518
Messages
6,179,258
Members
452,901
Latest member
LisaGo

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