VBA Loop Visible Cells Column, Copy left 7 digits

DonellaD

New Member
Joined
Aug 23, 2012
Messages
2
Hi,
I'm pretty new to VBA and desperately need help! I have to loop through a column of data, select only the visible cells in that column, extract the left seven characters then paste them into an external workbook I've already created. This data will be pasted on sheet2 of the external workbook. I have already copied data from the master workbook, opened a new workbook and pasted that data on sheet1. Now I need to go back to the master workbook, sheet2, to the filtered column AD, copy only the first 7 digits in each cell and paste it onto sheet2 in the workbook I have already created.

I know how to loop, select.SpecialCells(xlCellTypeVisible), get only the left 7 characters in a cell, but I'm having difficulty piecing it all together into a loop that will do all of these and paste it into an external workbook on sheet 2. The filtered range will always be different, as it displays data for the individual unit that is selected so it can be anywhere from a 3 or 4 rows to 20.

Please help...I've been struggling with this for more than a week and I cannot find anything that does what I need to accomplish.
 

Ferdi24

Board Regular
Joined
Feb 26, 2012
Messages
133
This code is a bit clumsy but should work in case nobody responds with a squeaky clean alternative ;)

Code:
Option Explicit 
Sub VisibleCellsFirstSeven()
Dim i As Long
Dim mCell As Range
Dim DataRange As Range
Dim TempStore As String
Dim ExternalWorkbook As Workbook
Dim InternalWorkbook As Workbook

'Selects the column you have currently clicked in to work with
Set DataRange = ActiveWorkbook.ActiveSheet.UsedRange.Columns(ActiveCell.Column - ActiveSheet.UsedRange.Column + 1)

'Which is the external workbook?
Set InternalWorkbook = ThisWorkbook
Set ExternalWorkbook = Workbooks.Open("C:\...\...xls") ' INSERT YOUR EXTERNAL FILENAME HERE
InternalWorkbook.Activate


For i = 0 To DataRange.Rows.Count - 1
Set mCell = Cells(DataRange.Row, DataRange.Column).Offset(i)
    If mCell.EntireRow.Hidden = False Then
        If Len(mCell.Value) >= 7 Then
          TempStore = Left(mCell.Value, 7)
          'On this sheet find the last row in Column A
          ExternalWorkbook.Sheets(2).Cells(Rows.Count, 1).End(xlUp).Offset(1).Value = TempStore
        End If
    End If
Next i
ExternalWorkbook.Activate
End Sub
 

DonellaD

New Member
Joined
Aug 23, 2012
Messages
2
oh my goodness!!! Thank you so much!!! I will try this now and see if it works!!!!:ROFLMAO:
 

Forum statistics

Threads
1,085,429
Messages
5,383,628
Members
401,843
Latest member
stevensmith1

Some videos you may like

This Week's Hot Topics

Top