I have some code here which works great. I would like to customize it in a different way though, and have been unsuccessful at doing so and am therefore reaching out to this community. I will try to explain what I would like to do. What the macro does right now: it copies three rows to a new workbook (Rows 4 and 5 as well as the row of the active cell, based on whether the row of the active cell has non-empty cells). What I would like to do is that I would like the macro to copy the following rows to a new workbook:
-Row 4 & 5 (like it's doing right now), but based on whether the below row(s) has(have) non-empty cells.
-any row which i have selected. So instead of just one other row being copied, several other rows should be copied, depending on which rows i select.
To summarize: Assuming I select row 6,8, & 10. When running the macro, a new workbook is created where the following rows have been copied:
-Row 4 & 5
-Row 6,8, & 10 *The condition being however that only those columns are copied where Row 6,8, & 10 are non-empty.
Assuming I select row 14, 54, 31, 64, 65. When running the macro, a new workbook is created where the following rows have been copied:
-Row 4 & 5
-Row 14, 54, 31, 64, 65 *The condition being however that only those columns are copied where Row 14,54,31,64 & 65 are non-empty.
The overall logic of the current code thus doesn't change. Rather, what changes is that I would like to be able to copy several rows apart from 4&5 instead of just one other (as it is doing now-based on where the active cell is)
Here is the code, I hope I have been clear. If anyone has any idea where i could start/how i could do this, please let me know, thanks!!
Public Sub pub_sub_ExportRows()
'#
'# declare private variables
'#
Dim pvt_xls_Current As Excel.Worksheet
Dim pvt_wbk_New As Excel.Workbook
Dim pvt_lng_SelectedSourceRow As Long
Dim pvt_flg_ValidRow As Boolean
Dim pvt_lng_RowNumber As Long
Dim pvt_lng_FirstColumn As Long
Dim pvt_lng_LastColumn As Long
Dim pvt_lng_ColumnNumber As Long
Dim pvt_lng_TargetColumn As Long
'#
'# record the current row based on the active cell
'#
Set pvt_xls_Current = ThisWorkbook.ActiveSheet
pvt_lng_SelectedSourceRow = ActiveCell.Row
'#
'# the maximum number of columns to be considered is not dependent on the columns defined in the
'# worksheet, but rather by a limit imposed by the user - i.e. column HG is the last column to be copied,
'# and column Q is the first column to be considered
'#
pvt_lng_FirstColumn = Columns("Q").Column
pvt_lng_LastColumn = Columns("HG").Column
pvt_lng_TargetColumn = 0
'#
'# check if the selected row is valid by examining the values in the columns on that
'# row - any non-blank value implies that the selected row is valid - when looking at
'# the values the search starts in column Q as requested by the user
'#
With pvt_xls_Current
pvt_flg_ValidRow = False
For pvt_lng_ColumnNumber = pvt_lng_FirstColumn To pvt_lng_LastColumn
If LenB(.Cells(pvt_lng_SelectedSourceRow, pvt_lng_ColumnNumber).Value) > 0 Then
pvt_flg_ValidRow = True
Exit For
End If
Next pvt_lng_ColumnNumber
End With
If Not pvt_flg_ValidRow Then
MsgBox "You must select a valid - i.e. non empty - row"
Exit Sub
End If
If pvt_lng_SelectSourceRow > 10000 Then
MsgBox "You may not select a row > 10000"
Exit Sub
End If
'#
'# create a new workbook to hold the copied values and copy & paste the information to the
'# newly created workbook
'#
Set pvt_wbk_New = Application.Workbooks.Add
With pvt_xls_Current
For pvt_lng_ColumnNumber = pvt_lng_FirstColumn To pvt_lng_LastColumn
If LenB(.Cells(pvt_lng_SelectedSourceRow, pvt_lng_ColumnNumber).Value) > 0 And _
InStr(1, "$AF,$BF,$CG,$DH,$ES,$FV,$HD, $HF", Split(Columns(pvt_lng_ColumnNumber).Address, ":")(0)) = 0 Then
pvt_lng_TargetColumn = pvt_lng_TargetColumn + 1
pvt_wbk_New.Worksheets("Sheet1").Cells(1, pvt_lng_TargetColumn).Value = .Cells(4, pvt_lng_ColumnNumber).Value
pvt_wbk_New.Worksheets("Sheet1").Cells(2, pvt_lng_TargetColumn).Value = .Cells(5, pvt_lng_ColumnNumber).Value
pvt_wbk_New.Worksheets("Sheet1").Cells(3, pvt_lng_TargetColumn).Value = .Cells(pvt_lng_SelectedSourceRow, pvt_lng_ColumnNumber).Value
End If
Next pvt_lng_ColumnNumber
End With
'#
'# activate the new workbook
'#
pvt_wbk_New.Activate
pvt_wbk_New.Worksheets("Sheet1").Cells(1, pvt_lng_TargetColumn).EntireRow.Columns.AutoFit
End Sub
Links for cross-posts:
http://stackoverflow.com/questions/1...k-based-on-a-c
http://www.ozgrid.com/forum/showthread.php?t=173353
Bookmarks