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
Related
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
I've had a pretty thorough search but I'm still struggling with this problem. Essentially, I have a list of various titles, each of which has 10 variables corresponding, which may or may not have data points.
I'd like to loop through the first column, with a nested loop going through each row to count and record the number of populated data points in each. Mostly I'm not sure how to reference cells in the second loop. Any help would be greatly appreciated!
I dont really understand your ultimate goal however i hope the code below will help you to go to the right direction.
As far as i understand i wrote a code that COUNT how many cells for each row where there s data.
I am not really sure if it is what you want but let me know and i will edit my code to your requirement.
Option Explicit
Sub test()
Dim wb As Workbook
Dim ws As Worksheet
Dim Lastrow As Long
Dim i As Long, j As Long, c As Long
Set wb = ThisWorkbook
Set ws = wb.Sheets("Sheet1") ' Change the name of your worksheet
Lastrow = ws.Cells(Rows.Count, 1).End(xlUp).Row ' Find the las row
With ws
For i = 1 To Lastrow 'Start at row 1 until the last row
c = 0
For j = 2 To 11 ' 10 Variables (until the column "L")
If Not IsEmpty(.Cells(i, j)) Then c = c + 1 ' Count and record the number of populated data points in each columns
Next j
.Cells(i, 12).Value = c 'Past the result in column "L"
Next i
End With
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 am new to VBA and I hope I am not asking too much by asking for an explanation with an answer.
I want to look for duplicates in my activeworksheet based on 3 different columns per rows. Then I want to highlight that EntireRow (used cells only) any color.
I need to store 3 different cells in the first row then loop through each used row and compare it to the 3 next relative cells
So far I have gutted some other peoples nice code for the loop but i dont know how to properly do what i want.
Sub CompareHighlightDupRows()
Dim oRow As Range, rng As Range
Dim myRows As Range
With Sheets("Sheet3")
Set myRows = Intersect(.Range("A:A").EntireRow, .UsedRange)
If myRows Is Nothing Then Exit Sub
End With
For Each oRow In myRows.Columns(1).Cells
Next
End Sub
thank you so much
i found the answer myself using a simpler method
Do While RowCount <> lastROW + 1
Do While RowCount <> lastROW + 1
RowCount = RowCount + 1
Loop
RowCount = RowCount + 1
Loop
going to use cells(rowcounter,columncounter) with a string concatenation to compare and an entirerow.usedrange to highlight interior color
Closed. This question needs details or clarity. It is not currently accepting answers.
Want to improve this question? Add details and clarify the problem by editing this post.
Closed 8 years ago.
Improve this question
I have a master sheet with 10,000 entries that has a common identifier in column A. I have many other sheets that have data and the same common ID, but for smaller populations. For example, there is a sheet for 1,500 senior citizens. Column A is the unique ID, Column B is a y for SENIOR_CITIZEN. How do I match these two sheets so that in my master there will be a new column in the master identifies the matches from the 1500 IDs from the senior citizen sheet to the 10,000 IDs on the master? VLOOKUP won't work because there are way more entries in the master than in the senior citizen file.
Using simple loops, this is very easy to accomplish. I'm not sure if I understood your question exactly, but I'm pretty certain this is what you want.
Note: in the code, I use Cells(sRow, "B") once and (tRow, 2) another time. They accomplish the same thing, and I'm writing it like that to show you how it works. You can either set the column value with a letter or a "LONG" typed variable. This lets you use a counter and loop through the rows and columns, skipping about however you see fit, logically for your needs.
Not knowing your sheet names, using "Seniors" and "Master":
TESTED:
Sub SeniorMatch()
Dim sh1 As String
Dim sh2 As String
Dim lastRow1 As Long 'For sh1
Dim lastRow2 As Long 'sh2
Dim tempID As String 'In case you use any letters in your ID
sh1 = "Seniors" 'Set the Sheet Names
sh2 = "Master"
lastRow1 = Sheets(sh1).Range("A" & Rows.Count).End(xlUp).row
lastRow2 = Sheets(sh2).Range("A" & Rows.Count).End(xlUp).row
'using sRow for SOURCE Row, and tRow for Target Row
For sRow = 2 To lastRow1
If Sheets(sh1).Cells(sRow, "B").Value = LCase("y") Then
tempID = Sheets(sh1).Cells(sRow, 1).Text
For tRow = 2 To lastRow2
If Sheets(sh2).Cells(tRow, 1) = tempID Then
Sheets(sh2).Cells(tRow, 2) = "y" 'Set col B to "y"
End If
Next tRow
End If
Next sRow
End Sub