Selecting non-blank cells in Excel with VBA - vba

I'm just beginning to dive into VBA and I've hit a bit of a roadblock.
I have a sheet with 50+ columns, 900+ rows of data. I need to reformat about 10 of those columns and stick them in a new workbook.
How do I programmatically select every non-blank cell in a column of book1, run it through some functions, and drop the results in book2?

I know I'm am very late on this, but here some usefull samples:
'select the used cells in column 3 of worksheet wks
wks.columns(3).SpecialCells(xlCellTypeConstants).Select
or
'change all formulas in col 3 to values
with sheet1.columns(3).SpecialCells(xlCellTypeFormulas)
.value = .value
end with
To find the last used row in column, never rely on LastCell, which is unreliable (it is not reset after deleting data). Instead, I use someting like
lngLast = cells(rows.count,3).end(xlUp).row

The following VBA code should get you started. It will copy all of the data in the original workbook to a new workbook, but it will have added 1 to each value, and all blank cells will have been ignored.
Option Explicit
Public Sub exportDataToNewBook()
Dim rowIndex As Integer
Dim colIndex As Integer
Dim dataRange As Range
Dim thisBook As Workbook
Dim newBook As Workbook
Dim newRow As Integer
Dim temp
'// set your data range here
Set dataRange = Sheet1.Range("A1:B100")
'// create a new workbook
Set newBook = Excel.Workbooks.Add
'// loop through the data in book1, one column at a time
For colIndex = 1 To dataRange.Columns.Count
newRow = 0
For rowIndex = 1 To dataRange.Rows.Count
With dataRange.Cells(rowIndex, colIndex)
'// ignore empty cells
If .value <> "" Then
newRow = newRow + 1
temp = doSomethingWith(.value)
newBook.ActiveSheet.Cells(newRow, colIndex).value = temp
End If
End With
Next rowIndex
Next colIndex
End Sub
Private Function doSomethingWith(aValue)
'// This is where you would compute a different value
'// for use in the new workbook
'// In this example, I simply add one to it.
aValue = aValue + 1
doSomethingWith = aValue
End Function

If you are looking for the last row of a column, use:
Sub SelectFirstColumn()
SelectEntireColumn (1)
End Sub
Sub SelectSecondColumn()
SelectEntireColumn (2)
End Sub
Sub SelectEntireColumn(columnNumber)
Dim LastRow
Sheets("sheet1").Select
LastRow = ActiveSheet.Columns(columnNumber).SpecialCells(xlLastCell).Row
ActiveSheet.Range(Cells(1, columnNumber), Cells(LastRow, columnNumber)).Select
End Sub
Other commands you will need to get familiar with are copy and paste commands:
Sub CopyOneToTwo()
SelectEntireColumn (1)
Selection.Copy
Sheets("sheet1").Select
ActiveSheet.Range("B1").PasteSpecial Paste:=xlPasteValues
End Sub
Finally, you can reference worksheets in other workbooks by using the following syntax:
Dim book2
Set book2 = Workbooks.Open("C:\book2.xls")
book2.Worksheets("sheet1")

For me the best way to proceed was to:
Create a new Excel Table
AutoFilter it by the parameter Criterial:="<>"
An example of the code would be:
Sub ExampleFilterCol()
' Create a Table
Dim ws As Worksheet
Dim rg As Range
Set ws = ActiveSheet
Set rg = ws.Range("A1").CurrentRegion
ws.ListObjects.Add(xlSrcRange, rg, , xlYes).Name = "myNonRepeatedTableName"
' Filter the created table
Dim Io As ListObject
Dim iCol As Long
' Set reference to the first Table on the sheet
' That should be the recently created one
Set lo = Sheets("Totalinfo").ListObjects(1)
' Set filter field
iCol = lo.ListColumns("yourColumnNameToFilter").Index
' Non-blank cells – use NOT operator <>
lo.Range.AutoFilter Field:=iCol, Criteria1:="<>"
End Sub

This might be completely off base, but can't you just copy the whole column into a new spreadsheet and then sort the column? I'm assuming that you don't need to maintain the order integrity.

Related

VBA: Copying a range (row-by-row) in a loop and inserting this (row-by-row) in a new sheet (loop + if statement)

In VBA I try to run a loop with an if statement. The loop is set to run a row at a time for a range (wks "Data", B7:J25).
For each row if the value at column C7:C25 is 1, I would like to copy that row (e.g. B7:J7) and insert it at the worksheet "temp" one at a time.
I have tried various codes, for example:
Sub start()
Dim i As Integer
Dim wsData, wsCalcAndOutput, wsTemp As Worksheet
For i = 1 To 25
If Cells((7 + i), 3) = "1" Then
Worksheets("Data").Range("B7:J7").Copy _
Worksheets("temp").Range("B7:J7")
End If
Next
End Sub
But then I can only copy and paste the first row of the range. Alternatively, I found this procedure at stackoverflow, but I can't seem to be able to paste what I copy at each iteration:
Dim wsData, wsCalcAndOutput As Worksheet
Dim rSPX, rSX5E, rNKY, rUKX, rSMI, rEEMUP, testData As Range
Sub start()
Dim i As Integer
For i = 1 To 25
If Cells((7 + i), 3) = "1" Then
With ActiveSheet
.Range(.Cells((7 + i), 2), .Cells((7 + i), 10)).Copy
End With
End If
Next
End Sub
Is this the right way to do so or is there a more efficient way?
Also - in the dataset the criteria for the if statement is actually a string called either "TRUE" or "FALSE". Can an if statement use a string as a signal instead of "1"?
All the best,
Christoffer
As BigBen says, using AutoFilter would be quicker but here is one way of doing this with a loop. Have added a few comments which hopefully explain the basics.
One problem with your code was that you weren't changing the destination cells so they would continually be overwritten.
Sub start()
Dim i As Long 'better than integer
Dim n As Long: n = 7
Dim wsData As Worksheet, wsCalcAndOutput As Worksheet, wsTemp As Worksheet 'specify each type
With Worksheets("Data")
For i = 7 To 25 'change as appropriate
If .Cells(i, 3) = 1 Then 'no need for quotes
Range(.Cells(i, "B"), Cells(i, "J")).Copy _
Worksheets("temp").Cells(n, "B") 'start at row 7?
n = n + 1 'update so that we don't overwrite next time
End If
Next
End With
End Sub

VBA extend rows with formulas

I have an Excel macro, which opens up a template file and saves it under a different name once everything is done.
My VBA loads (Sub Loading) some data from the database to the INPUT sheet. There is another sheet, which uses hlookup table5 to find rows in the INPUT sheet and do some calculations.
I need to extend this Table5 and have the same number of rows as in the INPUT sheet, but it's not working. Do you have any idea how can I achieve that?
StrSQL = "select * from mytable"
Set targetSh = owb.Sheets("INPUT")
Call Loading(targetSh, StrSQL)
Last = targetSh.Cells(Rows.count, "A").End(xlUp).Row
ActiveSheet.Range("Table5").Offset(14, 0).EntireRow.Insert Shift:=xlDown
This will make sure that you have inserted enough rows, that the table is in total with 20:
Sub TestMe()
Dim listObj As ListObject
Set listObj = Worksheets(1).ListObjects("Table5")
With listObj
.Resize listObj.Range.Resize(20)
End With
End Sub
And if you want to insert 20 rows to the rows that the table already has, then first the rows should be saved to a variable rowsTotal. Then, the inserted rows should be equal to rowsTotal+20:
Option Explicit
Sub TestMe()
Dim listObj As ListObject
Dim rowsTotal As Long
Set listObj = Worksheets(1).ListObjects("Table5")
rowsTotal = listObj.Range.Rows.Count
With listObj
.Resize listObj.Range.Resize(rowsTotal + 20)
End With
End Sub
Concerning the insertion of the formulas, you should not worry about it. Excel writes automatically the formula from the previous row on every newly inserted row.
I have solved it using this:
Sub RowsAction(ByRef targetSh As Worksheet, resizeSh As Worksheet, tablename
As String)
Dim i, iLastRow As Integer, oLastRow As ListRow, srcRow As Range
Last = targetSh.Range("A1", targetSh.Cells(Rows.count, "A").End(xlUp)).count - 2
For i = 1 To Last
Set srcRow = resizeSh.ListObjects(tablename).ListRows(i).Range
Set oLastRow = resizeSh.ListObjects(tablename).ListRows.Add
srcRow.Copy
oLastRow.Range.PasteSpecial
Application.CutCopyMode = False
Next
End Sub

VBA: Retrieve cell value from each row in Range.Area

The main goal is: Retrieve specific cell values from each row in a filtered table by using column reference name.
So far, I have the following code
Dim table As listObject
Dim columns As ListColumns
Dim row As ListRow
Dim rnData As range
Dim rngArea As range
Set table = Sheets(sheetName).ListObjects(TableName)
Set columns = table.ListColumns
Set rnData = ThisWorkbook.Worksheets(sheetName).ListObjects(TableName).range
'Notice that sheetName and TableName are function arguments. No need to pay attention. Consider any string values.
'Filter my table
table.range.AutoFilter Field:=7, Criteria1:=Array("filtervalue1", "filtervalue2"), Operator:=xlFilterValues
'Set the filtered table in a new Range object
Set rnData = ThisWorkbook.Worksheets(sheetName).ListObjects(TableName).range
'Count all rows of my filtered table
With rnData
For Each rngArea In .SpecialCells(xlCellTypeVisible).Areas
lCount = lCount + rngArea.Rows.Count
Next
End with
Now I want to loop my filtered table (my "rnData" range) and I want to get the cell value for each row in those Range.Areas.
I was thinking something like this, but i'm having difficulties with VBA to do this:
For iRowNo = 2 To (lCount - 1) 'Start at 2 because 1 is the table header
'This does not work once it gets another row from the entire table. Not the filtered one. Help here!
Set row = table.ListRows(iRowNo)
'Something close to this - Help Here!
Set row = rnData.SpecialCells(xlCellTypeVisible).Areas
''Would like to have the code like this to get the values
cell1Value= row.range(1, columns("My Column Header 1").Index).value
cell2Value= row.range(1, columns("My Column Header 2").Index).Value
Next iRowNo
Let me know if there are different solutions than this.
Following the #DirkReichel answer
Here is the code that worked for me:
Dim table As listObject
Dim columns As ListColumns
Dim row As ListRow
Dim rnData As range
Dim rngArea As range
Set table = Sheets(sheetName).ListObjects(TableName)
Set columns = table.ListColumns
Set rnData = ThisWorkbook.Worksheets(sheetName).ListObjects(TableName).range
'Notice that sheetName and TableName are function arguments. No need to pay attention. Consider any string values.
'Filter my table
table.range.AutoFilter Field:=7, Criteria1:=Array("filtervalue1", "filtervalue2"), Operator:=xlFilterValues
'Set the filtered table in a new Range object
Set rnData = ThisWorkbook.Worksheets(sheetName).ListObjects(TableName).range
'Get values for each row
With rnData
For Each rngArea In .SpecialCells(xlCellTypeVisible).Areas
For Each row In rngArea.Rows
cell1Value= row.range(1, columns("My Column Header 1").Index).value
cell2Value= row.range(1, columns("My Column Header 2").Index).Value
Next
'lCount = lCount + rngArea.Rows.Count 'Removed this.
Next
End with
'Also no need the second part of code with the For..Next loop.
I think you're indirectly trying to create an array which is not something that can be easily explained a single post, but here's some code to get you started.
I'm going to assume that your set rnData range is correct. From there, it's probably easiest to just loop through all cells in range. You could write code more precise than below, but this should help you see a couple ideas besides what you're trying.
Most important I think you're looking for a method to create an array. I hope this helps.
Sub testCoutinho()
Dim Rcell As Range
Dim rnData As Range 'you'll have to set this up...
Dim YesLetsDoAnArray As Boolean: YesLetsDoAnArray = False 'or change to false to just make a new sheet with values
If YesLetsDoAnArray Then
ReDim This_is_your_Array(0) As Variant 'Create Array
Dim x As Integer
Else
'putting values on a new worksheet in file
Dim CleanWS As Worksheet: Set CleanWS = ThisWorkbook.Sheets.Add
End If
For Each Rcell In rnData.Cells
If Rcell.EntireRow.Hidden = False Then
If YesLetsDoAnArray Then
ReDim Preserve This_is_your_Array(x)
This_is_your_Array(x) = Rcell.Value
x = x + 1
Else
CleanWS.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Value = Rcell.Value
End If
End If
Next Rcell
'If you used an array, you'll know have variable(s) that contain all your data.
'your first one is This This_Is_Your_Array(0), followed by This_Is_Your_Array(1)... etc.
'you can play around. this will print them all.
If YesLetsDoAnArray Then
Dim i As Integer
For i = 0 To x - 1
Debug.Print This_is_your_Array(i)
Next i
End If
End Sub

finding the next empty cell so that it wont overwrite the previous pasted data

I am having a problem to consolidate data from multiple worksheet into a summary worksheet. It is able to copy all the data except when the data is pasted it will overwrite the previous data. Example data in sheet A is pasted to recompile sheet starting from range A2. The problem is data in sheet B,C,D etc will also be pasted starting from range A2 causing it to overwrite each other.
This is my code.
Private Sub CommandButton2_Click()
Dim Sheetname, myrange As String
Dim A, noOfrows As Integer
Dim startRow As Integer
For i = 2 To Worksheets("Master Sheet").Cells.SpecialCells(xlCellTypeLastCell).Row
Sheetname = Worksheets("Master Sheet").Cells(i, 27).Value'All the sheets that suppose to transfer to recompile sheet
noOfrows = Worksheets(Sheetname).Cells.SpecialCells(xlCellTypeLastCell).Row
myrange = "A2:N" & CStr(noOfrows)
Worksheets(Sheetname).Select
Worksheets(Sheetname).Range(myrange).Select
Selection.Copy
Sheets("Recompile").Select
Range("A2").Select
ActiveSheet.Paste
Next i
End Sub
You need to find the UsedRange in the "Recompile" sheet and paste into the range below that:
Something like:
Private Sub CopyData()
Dim A As Long
Dim noOfrows As Long
Dim startRow As Long
Dim i As Long
Dim control As Worksheet
Dim source As Worksheet
Dim target As Worksheet
Set control = Worksheets("Master Sheet")
Set target = Worksheets.Add
For i = 2 To control.UsedRange.Rows.Count
' the target worksheet for this row of data
Set source = Worksheets(control.Cells(i, 1).Value) ' My example has this data in column A
' the address of a range with (number of rows - 1) for columns A:N
source.Range("A2:N" & source.UsedRange.Rows.Count).Copy
target.Range("A" & target.Cells.SpecialCells(xlCellTypeLastCell).Offset(1, 0).Row).PasteSpecial xlPasteValues
Next i
End Sub
Lots of information and tips here: http://www.rondebruin.nl/win/s3/win002.htm

Compile Error: Method 'Range' of object '_Global' failed - Search Copy Paste Macro Excel VBA

I'm trying to make a macro in Excel VBA 2007 that searches through the selected field and if it finds a certain string anywhere in a row, it copies and pastes that row into another sheet.
However, I'm getting the error in the title on the row noted below. What would be causing this?
Sub SearchCopyPaste()
'
' SearchCopyPaste Macro
' Searches for a string. If it finds that string in the line of a document then it copies and pastes it into a new worksheet.
'
' Keyboard Shortcut: Ctrl+Shift+W
'
Dim sourceSheet, destinationSheet As Worksheet
Set sourceSheet = Worksheets(1) 'Define worksheets
Set destinationSheet = Worksheets(2)
Dim selectedRange As Range 'Define source range
Set selectedRange = Selection
Dim numRows, numColumns As Integer 'Determine how many rows and columns are to be searched
numRows = Range(selectedRange).Rows.Count '<<<<<<<< Error
numColumns = Range(selectedRange).Columns.Count
destinationRowCount = 1 'Counter to see how many lines have been copied already
'Used to not overwrite, can be modified to add header,etc
Dim searchString As String 'String that will be searched. Will eventually be inputted
searchString = "bccs" 'Will eventually be put into msgbox
For rowNumber = 1 To numRows
If InStr(1, selectedRange.Cells(i, numColumns), searchString) > 0 Then
selectedRange.Cells(rowNumber, numColumns).Copy Destination:=destinationSheet.Range(Cells(destinationRowCount, numColumns))
destinationRowCount = destinationRowCount + 1
End If
Next rowNumber
End Sub
Try:
numRows = selectedRange.Rows.Count '<<<<<<<< Error
numColumns = selectedRange.Columns.Count
There may be other errors, I have not tested your full code, but this should fix the immediate error you're experiencing.
Some tips:
Declare all of your variables at the top of your sub
Add a new line for each variable to make your code more readable
Anytime you are using a variable to store row numbers declare it as Long
If you know the range you want to work with beforehand define it as a range in your code
This code should do something close to what you want. Give it a try and let me know.
If you know the range you would like to use before running the macro instead of using "Selection" I suggest specifying the exact range or "Sheets(1).UsedRange" for the entire first sheet.
Sub SearchCopyPaste()
Dim fnd As String
Dim vCell As Range
Dim rng As Range
Dim totalCols As Integer
Dim rowCounter As Long
'Set this to a specific range if possible
Set rng = Selection
totalCols = rng.Columns.Count
'Get the data to find from the user
fnd = InputBox("Input data to find")
'Loop through all cells in the selected range
For Each vCell In rng
'If the data is found copy the data and paste it to Sheet2, move down one row each time
If InStr(vCell.Value, fnd) > 0 Then
rowCounter = rowCounter + 1
Range(Cells(vCell.row, 1), Cells(vCell.row, totalCols)).Copy Destination:=Sheets(2).Cells(rowCounter, 1)
End If
Next
'Copy the column headers onto the second sheet
Sheets(2).Rows(1).EntireRow.Insert
rng.Range(Cells(1, 1), Cells(1, totalCols)).Copy Destination:=Sheets(2).Cells(1, 1)
End Sub