Closed. This question is not reproducible or was caused by typos. It is not currently accepting answers.
This question was caused by a typo or a problem that can no longer be reproduced. While similar questions may be on-topic here, this one was resolved in a way less likely to help future readers.
Closed 6 years ago.
Improve this question
I am new to VBA and coding in general.
I was trying my best to create a little VBA to help me automatically sum the rows of a table.
In my code, I have bolded the output. ie. after i click the macro, the sum is supposed to show and it is also supposed to be bolded.
However,I am not sure where I went wrong. :o Whenever I run, there is nothing seen.
I have tried to solve it by myself but it finds fault with the
.Cells(j, 1stCol + 1)
for both lines. I am not sure if there are any other faults because I cannot troubleshoot this myself.
Could anybody kindly help?
Also, does anybody have any good books to read up more on VBA? The internet confuses me quite a lot of the time I am trying to learn.
Thank you all for your help!
here is my code.
Option Explicit
Sub addHorizontalSums()
Dim lstCol As Integer
With Excel.ThisWorkbook.Sheets("Sheet1")
lstCol = .Cells(1, .Columns.Count).End(Excel.xlToLeft).Column
Dim j As Integer
For j = 1 To .Cells(1, .Columns.Count).End(Excel.xlToLeft).Column
.Cells(j, 1stCol + 1) = "=SUM(RC[-" & lstCol - 1 & "]:RC[-1])"
.Cells(j, 1stCol + 1).Font.Bold = True
Next j
End With
End Sub
This is an update...
Davesexcel,
The formula you gave I think only works if all the rows are the same length, however, if they arent, it will cut the data in half based on the first row found. I need to be able to calculate rows of different lengths.
The updated code you gave doesnt work too well. If you look at the Note Column, there are like many gaps of different gap spaces and the latest formula always results in debug message, without being fully calculated.
Is there a way for me to SUM all the numbers in each little sub-table BUT only subtracting the last no. Eg. if there are 9 items in a list with the 10th being the subtotal, is there code to SUM the 9 and then subtract the 10th, to give an overall result of 0?
Lastly, is it possible to highlight all the data that is being churned out, say in yellow? This would help me do the recording down quickly.
Thanks guys for all of your help!
Appreciated with much thanks! :)
First, you probably meant to write lstCol instead of 1stCol in the For-loop.
Second, if I get you right you want to show the sum of each row after the last cell in each row. If so, the variable j must go from 1 to the number of rows used on your sheet, not the number of columns. The following code should do the task.
Sub addHorizontalSums()
Dim j As Integer
Dim lstCol As Integer
With Excel.ThisWorkbook.Sheets("Sheet1")
lstCol = .Cells(1, .Columns.Count).End(Excel.xlToLeft).Column
For j = 1 To .Cells(1, 1).End(xlDown).Row
.Cells(j, lstCol + 1) = "=SUM(RC[-" & lstCol - 1 & "]:RC[-1])"
.Cells(j, lstCol + 1).Font.Bold = True
Next j
End With
End Sub
As a remark, you might want to use a different way to determine lstCol in case you have different numbers of entries in each row. You could for example use the following code, which I think should be more robust:
Sub addHorizontalSums()
Dim j As Integer
With Excel.ThisWorkbook.Sheets("Sheet1")
For j = 1 To .Cells(1, 1).End(xlDown).Row
.Rows(j).End(xlToRight).Offset(0, 1).Value = Application.WorksheetFunction.Sum(Rows(j))
.Rows(j).End(xlToRight).Font.Bold = True
Next j
End With
End Sub
You are limiting the number of rows to equal the number of columns, you should count the columns and rows separately.
For example,(change 1 to 2 in the rng,if you want it to start on row 2)
Sub Button2_Click()
Dim LstCol As Long, LstRw As Long, Rng As Range, Sh As Worksheet
Set Sh = Sheets("Sheet1")
With Sh
LstCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
LstRw = .Cells(.Rows.Count, LstCol).End(xlUp).Row
Set Rng = .Range(.Cells(1, LstCol + 1), .Cells(LstRw, LstCol + 1))
End With
With Rng
.Formula = "=SUM(RC[-" & LstCol & "]:RC[-1])"
.Font.Bold = 1
.Value = .Value 'use if you only want to show values, not formula
End With
End Sub
Sum between blanks
Before
After
Sub SumBetweenBlanks()
Dim RangeArea As Range, x As Long
x = Cells(1, Columns.Count).End(xlToLeft).Column
For x = 1 To x
For Each RangeArea In Columns(x).SpecialCells(xlCellTypeConstants, 1).Areas
With RangeArea.Offset.End(xlDown).Offset(1)
.Value = Application.Sum(RangeArea)
.Font.Bold = 1
End With
Next RangeArea
Next x
End Sub
Related
I am having a difficult time coming up with a solution for a project I'm working on. I am needing a Macro to look at a specific sheet, find a specific value, and cut/paste that value at the end of the row.
Looking at the example file I have attached, you can see that each customer has a unique ID in column A.
They are answering a questionnaire, and each answer they give generates a unique ID.
The order of the answer ID's doesn't matter, as they are unique. The only one that DOES matter is the answer with Semicolons. That answer ID needs to be the customer's last ID. So I need to find a way to cut these answer ID's and paste them to the end of each row.
I want the semi-colon answer to be the last answer in the array. First time posting on here so I'm sorry if the format is incorrect.
Updated: Example File
I think that this will do what you're looking for. It goes through columns and loops through each row in those columns and once it finds a cell with a ;, it just moves that value down to the bottom of the row it was found in.
Sub AnswerID()
Dim lastCol As Long
lastCol = Cells(1, Columns.count).End(xlToLeft).Column
Dim i As Long
For i = 1 To lastCol
Dim lastRow As Long
lastRow = Cells(Rows.count, i).End(xlUp).row
Dim j As Long
For j = 1 To lastRow
If InStr(Cells(j, i), ";") > 0 Then
Cells(lastRow, i).offset(1, 0).Value2 = Cells(j, i).Value2
Cells(j, i).Value2 = vbNullString
Exit For
End If
Next j
Next i
End Sub
Closed. This question needs to be more focused. It is not currently accepting answers.
Want to improve this question? Update the question so it focuses on one problem only by editing this post.
Closed 5 years ago.
Improve this question
I cannot find a method to do the following:
Say I have a data set of anywhere between 5-50,000 rows of data output (only ~20ish columns). I would like to graph this data set but it is quite memory taxing. Is there a macro to hide 9 out of every 10 rows to essentially cut the dataset down to 10% (more manageable to graph)? The data is collected every few seconds so I can easily cut out superfluous data without impact to the graph.
I've tried "delete/hide every other row loops" but it still leaves a large amount of information. I would think a 90% (or, if tunable, an X% cut) would help best. Thanks for any comments.
This code will randomly select/delete 90% of rows. It might not be exactly 90% because of randomness. Plenty of methods of ensuring exactly 90% but I prefer this for simplicity.
Sub RemoveRows()
Dim inputRange As Range, removeRange As Range, r As Range
Set inputRange = Sheet1.Range("A1:A1000")
Randomize
For Each r In inputRange
If Rnd < 0.9 Then
If removeRange Is Nothing Then
Set removeRange = r
Else
Set removeRange = Union(removeRange, r)
End If
End If
Next r
removeRange.EntireRow.Select
'removeRange.EntireRow.Delete
End Sub
Below code will hide every x number of rows in the range. You can assign value of x in variable rowCnt which is =9 in the code.
Sub Demo()
Dim rng As Range, cel As Range, hideRng As Range
Dim lastRow As Long, rowCnt As Long, i As Long
Dim ws As Worksheet
rowCnt = 9 'number of rows to hide
Set ws = ThisWorkbook.Sheets("Sheet5") 'change Sheet5 to your data sheet
With ws
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row 'last row with data using Column A
For i = 2 To lastRow Step rowCnt + 1 'loop through Column A starting from Row 2
If hideRng Is Nothing Then
Set hideRng = Range(.Cells(i, 1), .Cells(i + rowCnt - 1, 1)) 'get range of 9 cells
Else
Set hideRng = Union(hideRng, Range(.Cells(i, 1), .Cells(i + rowCnt - 1, 1))) 'union range of 9 cells
End If
Next i
End With
hideRng.EntireRow.Select 'use this line to select rows
'hideRng.EntireRow.Hidden = True 'use this line to hide rows
'hideRng.EntireRow.Delete 'use this line to delete rows
End Sub
I am trying to come up with a lean and error-proofed macro to delete rows containing duplicate values in a column A. I have two solutions and both have their advantages. None of them are exactly what I want.
I need rows containing duplicates deleted but leaving the last row that contained the duplicate.
This one is awesome. It has no loop and works instantaneously. The problem is that it deletes subsequent rows containing duplicates hence leaving the first occurrence of the duplicate (And I need the last/ or second - most show up only twice)
Sub Delete()
ActiveSheet.Range("A:E").RemoveDuplicates Columns:=1, Header:=xlNo
End Sub
This one goes from the bottom and deletes duplicates. It lasts longer than the first one ( I have around 6k rows) But the issue with this one is that it doesnt delete them all. Some duplicates are left and they are deleted after I run the same code again. Even smaller number of duppes is still left. Basically need to run it up to 5 times and then I end up with clean list.
`
Sub DeleteDup()
Dim LastRowcheck As Long, n1 As Long, rowschecktodelete As Long
LastRowcheck = Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
For n1 = 1 To LastRowcheck
With Worksheets("Sheet1").Cells(n1, 1)
If Cells(n1, 1) = Cells(n1 + 1, 1) Then
Worksheets("Sheet1").Cells(n1, 1).Select
Selection.EntireRow.Delete
End If
End With
Next n1
End Sub
`
Is there a way to improve any of these to work well or is there a better solution? Any info is greatly appreciated. Thanks
The easiest way would be to delete all rows at once. Also to increase speed, you better do your checks with variables and not with the real cell values like this:
Sub DeleteDup()
Dim LastRowcheck As Long
Dim i As Long
Dim rows_to_delete As Range
Dim range_to_check As Variant
With Worksheets("Sheet1")
LastRowcheck = .Cells(Rows.Count, 1).End(xlUp).Row
range_to_check = .Range("A1:A" & LastRowcheck).Values
For i = 1 To LastRowcheck - 1
If range_to_check(i, 1) = range_to_check(i + 1, 1) Then
If rows_to_delete Is Nothing Then
Set rows_to_delete = .Cells(i, 1)
Else
Set rows_to_delete = Union(.Cells(i, 1), rows_to_delete)
End If
End If
Next n1
End With
rows_to_delete.EntireRow.Delete
End Sub
The concept is right, but remember that when you delete rows, Cells(n1 + 1, 1) isn't going to be the same thing as it was before you deleted a row. The solution is to simply reverse the loop and test rows from bottom to top:
Sub DeleteDup()
Dim last As Long
Dim current As Long
Dim sheet As Worksheet
Set sheet = Worksheets("Sheet1")
With sheet
last = .Range("A" & .Rows.Count).End(xlUp).Row
For current = last To 1 Step -1
If .Cells(current + 1, 1).Value = .Cells(current, 1).Value Then
.Rows(current).Delete
End If
Next current
End With
End Sub
Note that you can use the loop counter to index .Rows instead of using the Selection object to improve performance fairly significantly. Also, if you grab a reference to the Worksheet and toss the whole thing in a With block you don't have to continually dereference Worksheets("Sheet1"), which will also improve performance.
If it still runs too slow, the next step would be to flag rows for deletion, sort on the flag, delete the entire flagged range in one operation, then sort back to the original order. I'm guessing the code above should be fast enough for ~6K rows though.
I've been looking around everywhere. But I don't know what words to google.
I want to remove every row where the cell in the C column doesn't contain 7 or 8 numbers. The problem is that I don't know how to code this.
What is the symbol in VBA code for 1 letter, 1 number, 1 or more letters, 1 or more numbers, space etc? I have been googling for hours but I guess I just don't know the right search words. Where or how can I find this? It's pretty dumb I know.
Thanks a lot.
EDIT:
#eirikdaude Thank you for your answer.
Somehow it doesn't work. This is what I have:
Dim lastRow As Long
lastRow = Cells(Rows.Count, 3).End(xlUp).Row
Dim i As Integer
For i = 2 To lastRow
If (IsNumeric(Cells(i, 3).Value) And Len(Cells(i, 3).Value) >= 7 And Len(Cells(i, 3).Value) <= 8) Then
' do nothing
Else
Rows(i).Select
Selection.Delete Shift:=xlUp
End If
Next i
I've been trying everything, but I don't understand why this code above doesn't work.
Does it matter that all my cells are formatted "standard" in excel? Because all data is imported from a txt file.
Unless you insist on using a regex for this, I'd simply check for the length of the value in the cell and if it IsNumeric.
In your case, something like this:
For Each c In rangeToCheck
If IsNumeric(c) And Len(c) >= 7 And Len(c) <=8) Then
do your stuff
End If
Next c
There two probably reason for which you code is no deleting the expected rows:
Expected lines to be deleted may be skipped by the code as it's deleting rows from top to bottom. When deleting several rows the correct method is to do it upwards (i.e. from bottom to top)
As your data is imported from a text file it's possible that values in column C have some extra blank spaces at the end. The use of TRIM takes care of this situation.
The code below includes both corrections:
Sub Rng_Delete_Rows()
Dim LRowLst As Long, LRow As Long
Dim vCllVal As Variant
'Change SheetName as required
With ThisWorkbook.Sheets(1) 'Use this if procedure resides in Data workbook
'With ThisWorkbook.Sheets(1) 'Use this if procedure does not reside in Data workbook
Application.Goto .Cells(1), 1
LRowLst = .Cells(.Rows.Count, 3).End(xlUp).Row
For LRow = LRowLst To 2 Step -1
Rem Get Cell Value At Once
vCllVal = Trim(.Cells(LRow, 3).Value2)
If Not ((IsNumeric(vCllVal) _
And Len(vCllVal) >= 7 And Len(vCllVal) <= 8)) Then
Rem Delete Row
.Rows(LRow).EntireRow.Delete
End If: Next: End With
End Sub
I always receive type missmatch errors or division by zero errors while trying to implement following: I just want to count the number of unique entries in a range, the entries in the range are of "class" text:
startRow = 3
startColumn = 1
col = "A"
Set topCell = Cells(startRow, startColumn)
Set bottomCell = Cells(Rows.Count, startColumn)
If IsEmpty(bottomCell) Then Set bottomCell = bottomCell.End(xlUp)
Set selectRows = Range(col & topCell.Row & ":" & col & bottomCell.Row)
nRows = WorksheetFunction.CountA(selectRows)
test = WorksheetFunction.SumProduct(WorksheetFunction.IsText(selectRows) / WorksheetFunction.CountIf(selectRows, selectRows))
I have a bug in the computation for test, but I don't get it. Some help very appreciated
Thanks a lot
BR
Martin
Your first problem is the WorksheetFunction.CountIf(selectRows, selectRows) part of your test calculation. When there are no duplicates, this will result in a division by zero error. This will occur when typed into a worksheet as well, so you will either need to change your logic, or test for this case first.
Your Type Mismatch problem, I believe, is caused by the WorksheetFunction.IsText(selectRows) segment. I have not been able to figure out what is causing it, but as i mentioned in my comments, I think the IsText() function may not take a range in VBA like it does when typed into a cell.
I would probably approach this problem in a different way. Here's an example I found elsewhere on SO Count unique values in Excel
This mostly has worksheet formulas, but there is 1 answer with VBA code that you probably could adapt.
Another option is to create a collection and count the number of elements
Sub CountUnique()
Dim Col As New Collection
Dim i As Integer
On Error Resume Next
For i = 3 To 10
Col.Add Sheet1.Cells(i, 1).Value, Sheet1.Cells(i, 1).Value
Next
MsgBox Col.Count
On Error GoTo 0
End Sub