Finding the last used column and selecting certain range

[AceKnocks]

Hi,
I've a rows and columns filled up like below.

col1 col2 col3 col4 col5 col6 col7
-------------------------------------------
Row1- c11 c12 c13 c14 c15 c16
Row2- c21 c22 c23 c24 c25 c26
Row3- c31 c32 c33 c34 c35 c36
Row4- c41 c42 c43 c44 c45 c46
Row5- c51 c52 c53 c54 c55 c56
Row6- - - - - - -
Row7- c71 c72 c73 c74 c75 c76 c77 c78
Row8- c81 c82 c83 c84 c85 c86 c87 c88
Row9- c91 c92 c93 c94 c95 c96 c97 c98

How should I know that last used column is col7 for rows (1 to 5)?
Same Qns for Rows (7 to 9)?
After that I want to select the used range (excluding col1) for both of teh ranges.

Thx.

 

[AceKnocks]

bang Finding the last used column and selecting certain rang

Neone? Noone?

 

[jindon]

if entire row 6 is blank then

Range("a1").CurrentRegion.Columns.Count

&

Range("a7").CurrentRegion.Columns.Count


returns what you want

 

[AceKnocks]

Hi Jindan,
Thx for the kind reply but m sorry for, I forgot to mention that there are headers also, that are giving incorrect output because of region issue.

All of the below h's are headings and of no use to me. According to this data, my range which is to be selected should be
- For rows (2 to 5) --> Row2Col2:Row5Col7 (first used column 2 & last 7)
- For rows (7 to 9) --> Row2Col2:Row9Col9 (first used column 2 & last 9)

col1 col2 col3 col4 col5 col6 col7
-------------------------------------------
Row1- h1 h2 h3 h4 h5 h6 h7 h8 h9 h10 h11
Row2- h1 c11 c12 c13 c14 c15 c16
Row2- h1 c21 c22 c23 c24 c25 c26
Row3- h1 c31 c32 c33 c34 c35 c36
Row4- h1 c41 c42 c43 c44 c45 c46
Row5- h1 c51 c52 c53 c54 c55 c56
Row6- - - - - - -
Row7- h1 c71 c72 c73 c74 c75 c76 c77 c78
Row8- h1 c81 c82 c83 c84 c85 c86 c87 c88
Row9- h1 c91 c92 c93 c94 c95 c96 c97 c98

Thx again for ur quick consideration.

 

[jindon]

AceKnocks,
the code will return what you expect, but I don't this this is what you are after....

Sub test()
Dim r As Range, a, LastR As Long, i As Long
Dim FirstLastCol As Integer, SecondLastCol As Integer
LastR = Range("b2").End(xlDown).Row
ReDim a(1 To LastR) As Double
For Each r In Range("b2:b" & LastR)
    i = i + 1: a(i) = r.End(xlToRight).Column
Next
FirstLastCol = Application.Max(a)
SecondLastCol = ActiveSheet.UsedRange.Columns.Count
MsgBox Range("b2", Cells(LastR, FirstLastCol)).Address(0, 0) & vbLf & _
Range(Range("b2", Cells(Range("b65536").End(xlUp).Row, SecondLastCol)).Address(0, 0)
End Sub

 

[AceKnocks]

finding the last used column

Hi Jindan,
I've modified your code according to my requirements. Basically the same code will be executed twice. Now what my requirement is, this selected code have to be copied onto another workbook.

Please see the code below.

Option Explicit
Dim x As Integer
Dim wkbk_Name As String
Dim CopyFile
Sub FindWorkbooks()
Dim Dir_Location As String
Dir_Location = "C:\Documents and Settings\AceKnocks\Desktop\test"
With Application.FileSearch
    .NewSearch
    .LookIn = Dir_Location
    .FileType = msoFileTypeExcelWorkbooks
    If .Execute > 0 Then 'found a workbook
        For x = 1 To .FoundFiles.Count
            CopyFile = .FoundFiles(x)
            MsgBox .FoundFiles(x)
            Call CopySheet(.FoundFiles(x)) 'goto copying routine
        Next x
    End If
End With
End Sub
Sub CopySheet(ByVal wkbk_Name As String)
    Dim w As Worksheet, i As Long, n As Long
    Application.ScreenUpdating = False
    On Error Resume Next
    Workbooks.Open FileName:=wkbk_Name
    Workbooks(wkbk_Name).Activate
    'MsgBox ActiveWorkbook.Name
    For Each w In Worksheets
        If w.Name = "wksh2" Then
            w.Activate
            Dim r As Range, a, LastR As Long
            Dim FirstLastCol As Integer, SecondLastCol As Integer
            LastR = Range("b4").End(xlDown).Row
            MsgBox LastR
            ReDim a(1 To LastR) As Double
            For Each r In Range("b4:b" & LastR)
                i = i + 1: a(i) = r.End(xlToRight).Column
            Next
            FirstLastCol = Application.Max(a)
            SecondLastCol = ActiveSheet.UsedRange.Columns.Count
            Range("b4", Cells(LastR, FirstLastCol)).Address(0, 0).Select
            Range("b4", Cells(LastR, FirstLastCol)).Address(0, 0).Copy
            ' I have to copy this range onto wkbk3 workbook. In that there is   Sheet1. Onto sheet1, _
            there will be same headers but there won't be any data
            MsgBox Range("b4", Cells(LastR, FirstLastCol)).Address(0, 0)
            
            LastR = Range("b12").End(xlDown).Row
            MsgBox LastR
            ReDim a(1 To LastR) As Double
            For Each r In Range("b12:b" & LastR)
                i = i + 1: a(i) = r.End(xlToRight).Column
            Next
            FirstLastCol = Application.Max(a)
            SecondLastCol = ActiveSheet.UsedRange.Columns.Count
            MsgBox Range("b12", Cells(LastR, FirstLastCol)).Address(0, 0)
        End If
    Next w
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    Cells(1).Select
    Workbooks(wkbk_Name).Close savechanges:=False
End Sub

Could you please tell me how to copy the selected range onto other sheet, one after the other.

So many thx in advance.
Cheers.

 

[jindon]

try (haven't tested)

Sub CopySheet(ByVal wkbk_Name As String) 
Dim w As Worksheet
Application.ScreenUpdating = False
Workbooks.Open Filename:=wkbk_name
Dim wbMstr As Workbook
Set wbMstr = Workbooks("wkbk3.xls")

With Workbooks(wkbk_name)
For Each w In Worksheets
    If w.Name = "wksh2" Then
        With w
            .Range("b4", .Cells(4, 256).End(xlToLeft)).Resize(3).Copy _
            Destination:=wbMstr.Sheets("wksh2").Range("iv4").End(xlToLeft).Offset(, 1)
            .Range("b12", .Cells(12, 256).End(xlToLeft)).Resize(3).Copy _
            Destination:=wbMstr.Sheets("wksh2").Range("iv12").End(xlToLeft).Offset(, 1)
        End With
    End If
    If w.Name = "wksh1" Then
        With w
            .Range("a2:b2").Resize(2).Copy _
            Destination:=wbMstr.Sheets("wksh1").Range("a65536").End(xlUp).Offset(1)
        End With
    End If
Next w
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
Cells(1).Select
Workbooks(wkbk_name).Close savechanges:=False
End Sub

 

[AceKnocks]

finding the last used column

Hi jindon,
Thx Man.
Ur code worked wonders for me. :wink: It's doing exactly as per my requirements.
Although I had to make some cosmetic changes here n there.

This is the final code.

Option Explicit
Dim x As Integer
Dim wkbk_Name As String
Dim CopyFile
Dim conWorkBook As Workbook
Dim fileName As String
Sub FindWorkbooks()
'Set conWorkBook = Workbooks("Consolidation Macro - V1")
Dim Dir_Location As String
Dir_Location = "C:\Documents and Settings\dilip_garg\Desktop\test"
With Application.FileSearch
    .NewSearch
    .LookIn = Dir_Location
    .FileType = msoFileTypeExcelWorkbooks
    If .Execute > 0 Then 'found a workbook
        For x = 1 To .FoundFiles.Count
            CopyFile = .FoundFiles(x)
            MsgBox .FoundFiles(x)
            Call CopySheet(.FoundFiles(x)) 'goto copying routine
        Next x
    End If
End With
End Sub
Sub CopySheet(ByVal wkbk_Name As String)
Dim w As Worksheet
Application.ScreenUpdating = False
Workbooks.Open fileName:=wkbk_Name
Dim wbMstr As Workbook
Set wbMstr = Workbooks("Consolidation Macro - V1.xls")

Call FileNameOnly(wkbk_Name)
Workbooks.Open (wkbk_Name)

With Workbooks(fileName)
For Each w In Worksheets
    If w.Name = "wksh2" Then
        With w
            .Range("b4", .Cells(4, 256).End(xlToLeft)).Resize(3).Copy _
            Destination:=wbMstr.Sheets("wksh2").Range("iv4").End(xlToLeft).Offset(, 1)
            .Range("b12", .Cells(12, 256).End(xlToLeft)).Resize(3).Copy _
            Destination:=wbMstr.Sheets("wksh2").Range("iv12").End(xlToLeft).Offset(, 1)
        End With
    End If
    If w.Name = "wksh1" Then
        With w
            .Range("a2:b2").Resize(2).Copy _
            Destination:=wbMstr.Sheets("wksh1").Range("a65536").End(xlUp).Offset(1)
        End With
    End If
Next w
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
Cells(1).Select
Workbooks(fileName).Close SaveChanges:=False
End Sub
Sub FileNameOnly(pname As String)
'   Returns the filename from a path/filename string
    Dim i As Integer, length As Integer, temp As String
    length = Len(pname)
    temp = ""
    For i = length To 1 Step -1
        If Mid(pname, i, 1) = Application.PathSeparator Then
            fileName = temp
            Exit Sub
        End If
        temp = Mid(pname, i, 1) & temp
    Next i
    fileName = pname
    Return
End Sub

So many thanks again, JINDON!!

 

[jindon]

AceKnocks,

Very nicely done!

jindon