First time using the site as I am new to VBA, but I am trying to write a piece of code that will look through a column of my choice, in this case column A, and go through each row and delete empty rows until the end of the dataset. I was thinking of doing a loop where I would reference the first cell in my dataset A1 and set the row number as a integer which would increase by 1 with each completion of the loop.
Private Sub CommandButton1_Click()
Dim X as Integer
Set X = 1
For X = 1 to 100
If Sheet1.Range("A":X).Value = "" Then Rows(X).EntireRow.Delete
Next X
End Sub
Thanks for any help or insights you can provide!
You want to concatenate in Range("A":X) so change : to & (or use cells).
When deleting rows you should step backwards or create a unionized range otherwise you will skip a row with every deletion you perform.
You don't want to set integers that is only for objects. There is also no benefit from using integer over long in VBA so best to just always use long as integer can give overflow errors in very large spreadsheets.
Rows(X).EntireRow.Delete is using a relative reference not an explicit one, use a with or explicitly reference every range object.
You are immediately overwriting X with the loop so you don't need to assign it a value before the loop.
Here's some code that will do what you need:
Dim lastrow As Long
Dim x As Long
With Sheet1
lastrow = .Cells(.Rows.Count, 1).End(xlUp).Row
For x = lastrow To 1 Step -1
If .Cells(x, 1).Value = "" Then
.Rows(x).EntireRow.Delete
End If
Next x
End With
You are missing your "End if". Also when looping through a range and deleting rows you need to loop bottom up because when a row is deleted it does not recalculate the range.
Sub CommandButton1_Click()
Dim x As Long
Dim lastrow As Long
lastrow = Range("A1" & Rows.Count).End(xlUp).Row
For x = lastrow To 1 Step -1
If Worksheets(1).Range("A" & x).Value = "" Then
Worksheets(1).Range("A" & x).EntireRow.Delete
End If
Next x
End Sub
Related
I have problem on swapping Column A to Column B then Column B to Column A, both column has row count of 2563. Is there any vba code to solve this problem?
I'm Already trying this code:
Private Sub CommandButton1_Click()
Dim temp As Double
temp = Range("A1").Value
Range("A1").Value = Range("B1").Value
Range("B1").Value = temp
End Sub
But it can only swap row 1 of both columns...
You can swap them all by a loop. For your case, the loop should go for 2563 times.
Private Sub CommandButton1_Click()
For i = 1 To 2563
temp = Cells(i, 1).Value
Cells(i, 1).Value = Cells(i, 2).Value
Cells(i, 2).Value = temp
Next i
End Sub
Using an array would be much faster than looping. In this example column A is copied into an array Hold_RNG. Then Column B is copied to column A, and then the Array is copied into Column B.
Sub SwapCOlumns()
Dim hold_rng() As Variant
Dim rowsToinclude As Long, WS As Worksheet
Set WS = ActiveSheet '<--- make sure this is correct worksheet
rowsToinclude = 2563 '<----- might want to make more dynamic
With WS
hold_rng = .Range("A1:A" & rowsToinclude)
.Range("A1:A" & rowsToinclude).Value = .Range("B1:B" & rowsToinclude).Value
.Range("B1:B" & rowsToinclude).Value = hold_rng
End With
End Sub
Updated: I don't mean to pick on the competing answer as it's simple and effective, but our two answers offer a good illustration of why using Arrays to impact a spreadsheet all at once, is much more efficient than looping and editing. I built this code which will time the results of each approach (inserting in Column E) of a spreadsheet. Through one round of 2563 rows the score was 0 seconds to 4. The array continued to output in 0 seconds while the loop approach fell to 41 seconds when doing 9 trials.
Screen Shot Of Results.
Timing code can be found on my PasteBin page (I don't want this answer to look ridiculously long)
I prefer to use arrays because is much faster.
Option Explicit
Sub test()
Dim i As Long
Dim arrA As Variant, arrB As Variant
Dim ValueA As Double, ValueB As Double
'Cahng if needed
With ThisWorkbook.Worksheets("Sheet1")
arrA = .Range("A1:A2563")
arrB = .Range("B1:B2563")
For i = 1 To 2563
ValueA = arrA(i, 1)
ValueB = arrB(i, 1)
arrA(i, 1) = ValueB
arrB(i, 1) = ValueA
Next i
.Range("A1").Resize(UBound(arrA), 1) = arrA
.Range("B1").Resize(UBound(arrB), 1) = arrB
End With
End Sub
Just to add it into the mix, there is a third way.
Insert a column after B. Copy A to C. Delete A.
With ThisWorkbook.Worksheets(1)
.Columns(3).Insert
.Columns(1).Copy .Columns(3)
.Columns(1).Delete
End With
(It assumes you want to move the whole column, but you normally would.)
However, the speed at which this will run depends upon the size of the worksheet and how many formulae it has.
I have been trying to find something that can help me online but no luck. I am trying to compare a value in column A with a value in Cell E1 and if match I want to put an X in column B next to the match in Column A.
here is my code I go so far:
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim a As Integer
Dim i As Integer
Dim x As Range
Dim y As Range
a = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
i = Worksheets("Sheet1").Range("E1")
x = Worksheets("Sheet1").Range("B1:a")
y = Worksheets("Sheet1").Range("A1:a")
'For Each cell In y
'if y = i then
'print "X" in column B next to the value
'MsgBox (i)
End Sub
thanks for your help in advance
Dan
There are a few things here that are worth mentioning. When you want to specify a range using .Range you have to specify the columns on both sides of the : ; furthermore, it takes a string. This means that what you're passing is "B1:a" which doesn't make sense to the computer because it doesn't know you want it to use the value of a instead of the letter. You need to pass "B1:B" & a to the .Range. What this does is concatenate the value you found in the variable a to the string so it appears as one string to the computer.
I personally think it's easier to take all of the values as a column vector instead of dimming the x's as a range because it makes the iteration a little easier. Instead of keeping track of what row I'm on, Counter will always tell me where I am since I'm just moving down a single column. As an added bonus, this reduces the times you access the worksheet which helps speed up your macro.
Although it's commented out, it's worth noting that the loop at the bottom of your sub wouldn't work because you haven't properly closed off the if or the for.
I'm not sure what you intended this for, but it's never a bad idea to use meaningful names so you can look back on your code and figure it out without too much effort. For example, I've renamed your a variable to lastrow which at a glance describes what value it stores.
Below your code that I've altered
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim lastrow As Long
Dim Criteria As Long
Dim x() As Variant
Dim Counter As Long
lastrow = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
Criteria = Worksheets("Sheet1").Range("E1").Value
x = Worksheets("Sheet1").Range("B1:B" & lastrow).value
For Counter = 1 To UBound(x)
If x(Counter,1) = Criteria Then
Worksheets("Sheet1").Cells(Counter, "B").Value = "X"
End If
Next Counter
MsgBox (Criteria)
End Sub
I little bit different approach. This find the last row in column A.
I also included if you want to match by wildcard, i.e. you want to find 45 in 645.
Sub Worksheet_SelectionChange()
Dim lrow As Integer
Dim a As Integer
Dim i As String
Dim Val As String
lrow = Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row 'Find last row
i = Worksheets("Sheet1").Range("E1") 'Set cell where compare value is
For a = 1 To lrow 'Loop from row 1 to last row in column A
Val = Cells(a, "A").Value 'Set value to compare in Column A
'If Val Like "*" & i & "*" Then 'Use this if you want to find 45 in 645, so wildcard
If Val = i Then 'Exact match
Cells(a, "B").Value = "X" 'Put X in column B
End If
Next a
MsgBox "Match Criteria: " & (i)
End Sub
I am trying to make some kind of inventory. So when on the second sheet I add a name of a certain product, it adds 1 up to the inventory I had in the first sheet in row E for that product. This for a list of names put in the 2nd sheet instead of just 1 name like tried out in the VBA code here.
After I am done with the list I should be able to clear sheet 2 and the values stay saved.
When I try this it gives an error and I just don't know how to make it work with letting it go over the entire list.
Private Sub CommandButton1_Click()
Dim x As Integer
x = Sheets("Sheet1").Cells(1, "E").Value
For Each cell In Sheets(Sheet1).Range("A:A")
If cell.Value = Sheets("Sheets2").Cells(1, "A").Value Then
x = x + 1
End If
Next cell
End Sub
You are thinking that x represents the cell, but it is a memory variable that starts with the Value in E1 on Sheet1.
If you want the range to increase then make the variable a range and set it to the range desired, or skip that all together:
Private Sub CommandButton1_Click()
Dim cell as Range
With Worksheets("Sheet1")
For Each cell In Intersect(.Range("A:A"),.UsedRange)
.Range("E1").value = .Range("E1").value + Application.WorksheetFunction.COUNTIF(Worksheets("Sheet2").Range("A:A"),cell.Value)
Next cell
End With
End Sub
Try this:
Private Sub CommandButton1_Click2()
Dim x As Integer
Dim lastRow As Long
Dim cell as Range
x = Sheets("Sheet1").Range("E1").Value
lastRow = Range("A" & Rows.Count).End(xlUp).Row ' assuming Col. A has most data
For Each cell In Sheets("Sheet1").Range("A1:A" & lastRow)
If cell.Value = Sheets("Sheets2").Range("A1").Value Then
x = x + 1
End If
Next cell
Debug.Print "x is now " & x
' Put the new value in E1
Sheets("Sheet1").Range("E1").Value = x
End Sub
I didn't do too much, just shortened the range so you don't loop through all of column A. Added Dim cell as Range, and put quotes around the Sheet1 in the For loop start. (That's where the error was coming from on that line). You can do Sheet1.Range(), or Sheets("Sheet1").Range, but not Sheets(Sheet1).Range without some additional coding/weird variable setup.
I have been trying to modify the data in a work sheet with some VBA, unfortunately the following code I'm using is not working properly.
Basically column A has the text, and I want to delete the entire row if the column A is "Pit" (not containing "Pit", but only "Pit"). For some reason the code is only deleting some rows but not others, so I have to keep running the script a few times to get rid of all the "Pit"s. There is nothing distinctly different between the rows it deletes and the ones it does not, they are all text & no spaces. There are thousands of rows with different column A text. Here is the code, I would greatly appreciate any suggestions.
Sub Pitdelete()
Dim lastrow As Long
Dim datasheet As Worksheet
Dim i As Long
Set datasheet = Worksheets("DefCatCou")
lastrow = datasheet.Range("a" & datasheet.Rows.Count).End(xlUp).Row
For i = 2 To lastrow
If datasheet.Cells(i, 1) = "Pit" Then
datasheet.Rows(i & ":" & i).EntireRow.delete
End If
Next i
End Sub
Thanks!
Just loop backwards when deleting rows:
Sub Pitdelete()
Dim lastrow As Long
Dim datasheet As Worksheet
Dim i As Long
Set datasheet = Worksheets("DefCatCou")
lastrow = datasheet.Range("a" & datasheet.Rows.Count).End(xlUp).Row
For i = lastrow To 2 step -1 'This should fix it.
If datasheet.Cells(i, 1) = "Pit" Then
datasheet.Rows(i & ":" & i).EntireRow.delete
End If
Next i
End Sub
Reason is that when you delete a row and increase the i with one, you basically skip the next row, since the delete shifted that one up.
The alternative is to add i = i - 1 after the EntireRow.Delete line.
Each time you delete a row all the rows below it move up.
You can declare another variable like this and increase it each time you delete row:
Dim c as Integer
c = 0
If datasheet.Cells(i, 1) = "Pit" Then
datasheet.Rows(i - c & ":" & i - c).EntireRow.delete
c = c + 1
...
#zipa is quite right - when you delete a row, the others move up, changing their index. As an alternative to his proposal, you can get the loop to run in reverse:
For i = lastrow To 2 Step -1
If datasheet.Cells(i, 1) = "Pit" Then
datasheet.Rows(i & ":" & i).EntireRow.delete
End If
next i
That way, if you delete a row, it won't affect the next index in your loop.
The code I've written below to replace some index match formulas in a sheet. It seems to work well enough, but I think the loop is a bit clumsy and may be prone to errors. Does anyone have any recommended improvements?
Sub match_SIC_code_sheet_loop()
'sic code needs to match value in column j or a in sic code sheet, '
'if not available = met10 works, but probably needs a bit more
'debugging to make it robust.
Dim ws As Integer
Dim lastrow As Long
Dim lastrow_sic As Long
Dim output_wb As Workbook
Dim SIC_sheet As Worksheet
Dim Demand_CAT As String
Dim sic_DMA As String
Dim i As Integer
Dim row As Integer
Dim WS_count As Long
Dim x As String
Dim y As String
Set output_wb = Workbooks("DMA_customers_SICTEST.xlsx") 'use thisworkbook instead
Set SIC_sheet = Workbooks("DMA_metered_tool_v12_SICTEST.xlsm").Sheets("SIC codes")
With SIC_sheet 'count the number of SIC codes to search through
lastrow_sic = .Range("j" & .Rows.Count).End(xlUp).row
End With
With output_wb 'count the no. of sheets in the generated customer workbook
WS_count = output_wb.Worksheets.Count
End With
With output_wb
For ws = 1 To WS_count 'loop through each sheet in the customer workbook
With output_wb.Sheets(ws)
y = output_wb.Sheets(ws).Name
lastrow = .Range("a" & .Rows.Count).End(xlUp).row ' number of rows in the
'current customer sheet
For i = 2 To lastrow 'data starts in row 2; sic code in column 9
sic_DMA = .Cells(i, 9).Text 'the lookup value
With SIC_sheet
'SIC codes start in row 2, if the sic code matches,
'the correct demand category is appointed, if the sic code does not
'match, then MET_10 is given as the default value.
For row = 2 To lastrow_sic
x = .Cells(row, 3).Text
If x = sic_DMA Then
Demand_CAT = .Cells(row, 10).Text
Exit For
Else
Demand_CAT = "MET_10"
End If
Next row
output_wb.Sheets(ws).Cells(i, 23).Value = Demand_CAT
End With
Next i
End With
Next ws
End With
output_wb.Save
End Sub
Thanks
For starters you could break that long procedure into a few smaller methods. For example you could have a ProcessSheet procedure into which you pass each sheet under :
For ws = 1 To WS_count 'loop through each sheet in the customer workbook
That would definitely help readability etc. If you're still not satisfied then continue breaking the loop into smaller logical procedures. Just don't go too crazy.
Apart from that some error checking and value validation would go a long way in a deeply nested loop. For example ensure that various calculated variables such as 'lastrow' are correct or within a valid threshold etc.
Finally instead of hardcoded values sprinkled through your long loop like magically camoflauged debug-from-hell-where's-waldo fairies; prefer instead a few meaningfully named Const variable alternatives i.e.
Private Const SIC_START_ROW = 2