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
Related
First off:
On file1 > sheet1 - I have Ids of data on column A.
On source file - I have a huge data with multiple columns with same column of Ids on column A in sheet1.
I trying vlookup to get data for multiple columns from another closed workbook but result is coming only for one column. Also i don't want to open a source file as file size is bit heavy (approx. 600mb).
below are the code which i am using for above scenario. i know this code not is correct and need more correction. So can someone help me into this.
Sub MyMacro()
Dim rw As Long, x As Range, lastrow As Long, lastcol As Long
Dim book1 As Workbook, twb As Workbook
Set twb = ThisWorkbook
Set book1 = Workbooks.Open("C:\Users\Charles Paul\Desktop\VBA\12-Oct\Record.xlsx")
Set x = book1.Worksheets("Sheet1").Range("A:A")
With twb.Sheets("Sheet1")
lastrow = x.cells(x.Rows.Count, x.Column).End(xlUp).Row
lastcol = x.cells(x.Row, x.Columns.Count).End(xlToRight).Column
For rw = 1 To .cells(Rows.Count, 1).End(xlUp).Row
.cells(rw, 2) = Application.VLookup(.cells(rw, 1).Value2, x, 1, False)
Next rw
End With
book1.Close savechanges:=False
End Sub
For large data sets, you might want to look into power query.
It is accessible from here:
I will not get into details, as setting up a query is a separate thing, but you can manage it with relevant VBA code.
For example, I have a data as the following in a column:
I need to make all possible unique combinations of this in another table in 2 columns using VBA like below:
Any help on how can I achieve this? Thanks.
PS. The column data is variable. It can have various number of currencies. The above one is just a small example.
This is an example how to find all these permutations. With this you should be able to solve it.
Option Explicit
Public Sub FindPermutations()
Dim ws As Worksheet
Set ws = Worksheets("Sheet1")
Const fRow As Long = 2 'first row
Const lRow As Long = 5 'last row
Dim i As Long, j As Long
For i = fRow To lRow
For j = i + 1 To lRow
'print out all permutations
Debug.Print ws.Cells(i, "A").Value, ws.Cells(j, "A").Value
Next j
Next i
End Sub
How does it work?
It uses 2 loops. The first one i runs through all rows. The second j only from the current i row to the last row. This ensures that already found combinations are not used again.
Note that I used constants for fRow and lRow for an easy demonstration. You might want to change them into variables in a production environment.
I'm a newbie to VBA/coding in general and my usual tactic of sticking bits of pre-written code isn't working for my problem.
I'm looking to create a macro that will do 3 things:
Allow me to find a starting point for the data in a column.
Start counting the number of rows once the cell value has
changed to a constant.
Once the value moves back to the starting point for the count to stop and record the number of cells counted in separate column with positioning of the count in that column at the start point of the count.
Repeat until the end of the data.
For this case the start point will be when the cell has a value of >0.
It will increase to a constant number (300).
Once at 300 the macro will have to count the number of rows that contain the numerical value 300 until the value goes back to 0.
Report count in a separate table on the worksheet with the entry being input at the same relative position in the new table as when the count started from the data.
And finally the loop.
I need to also do a similar count but in the horizontal direction (i.e. counting columns on a row). If anyone can create a code for the vertical/row count problem above I'd really appreciate it if you could annotate it so I can attempt to understand/learn which bits of code carry out each action and thus change it up for horizontal/column count.
I've attached a screenshot of the spreadsheet however as a new user it must be as a link. The blue highlighted table is the data used for the vertical /row count problem I am talking about. The blank table underneath the highlighted table has manually inputted correct answers for the first column of data for what I would like the macro to do in case I haven't accurately described my request.
I have also attached the horizontal table with correct manually inputted answers for row 1 in the separate table for the column count along the row.
Lastly, here is the code that I have written to tackle the problem, however it is very basic and won't run.
Sub Count0()
For Each c In Worksheets("Sheet1").Range("D30:D39")
If c.Value = 0 Then
End If
If c.Value > 0 Then
v = Range(c.Value)
For i = 3 To Rows.Count
If Cells(i, 1).Value <> v Then
MsgBox CStr(i - 2)
End If
Next i
Next c
End Sub
This worked in the limited case I tested (two columns and several rows in different patterns. It's pretty basic--there are more elegant ways to do it.
Sub Count0()
'To hold the current cell
Dim current As Range
'To hold the total number of rows and columns having data
Dim rows As Long
Dim cols As Long
'To iterate across rows and columns
Dim r As Long
Dim c As Long
'Flag/counter variables
Dim found As Long 'Saves row on which first "constant" was found
Dim count As Long 'Saves count of "contants"
'Use SpecialCells method to obtain the maximum number of rows and columns
' that have data.
cols = Worksheets("Sheet1").Cells.SpecialCells(xlCellTypeLastCell).Column
rows = Worksheets("Sheet1").Cells.SpecialCells(xlCellTypeLastCell).Row
'Increment through all columns that have data. This is a bit inefficient
' because it really isn't necessary to go through all the empty cells,
' but it works.
For c = 1 To cols
'Initialize flag/counter
found = 0
count = 0
'Increment through all rows for the current column.
For r = 1 To rows
'Examine the current cell
Set current = Worksheets("Sheet1").Cells(r, c)
'For positive values, save the first row that has the value
' and count the number of values.
If current.Value > 0 Then
If found = 0 Then found = r
count = count + 1
End If
'When the next non-positive value is reached--OR the end of the
' row is reached--and there was a constant found, write the count
' to the next worksheet in the cell corresponding to the row and
' column having the first instance of the constant.
If (current.Value <= 0 Or r = rows) And found > 0 Then
Worksheets("Sheet2").Cells(found, c).Value = count
'Reset the flag/counter
found = 0
count = 0
End If
Next r
Next c
End Sub
I was struggling with what you had written, and ended up doing this in the end. I left you variables for changing the sheets to read from and print to (assuming you can print the results to another sheet- if not it should be easy enough to change).
This should also work for all cells in your range, assuming that there are values in all boxes.
Problems I noted with your original code were:
The first if did nothing
I'm pretty sure you shouldn't use numbers in sub/function names
Dimensioning no variables is a bad idea
Anyway, give me a comment if you need any help (and well done for writing a good first question).
Sub CountZero()
Dim SourceSheet As Worksheet, SummarySheet As Worksheet
Dim CurrentCell As Range
Dim FirstRow As Long, LastRow As Long
Dim FirstColumn As Long, LastColumn As Long
Dim TotalValues As Long
Set SourceSheet = Worksheets("Sheet1")
Set SummarySheet = Worksheets("Sheet2")
FirstRow = 1
LastRow = SourceSheet.Range("A" & rows.count).End(xlUp).row
FirstColumn = 1
LastColumn = SourceSheet.Cells(1, Columns.count).End(xlToLeft).column
For col = FirstColumn To LastColumn
For Rw = FirstRow To LastRow
Set CurrentCell = SourceSheet.Cells(Rw, col)
If CurrentCell <> 0 Then
TotalValues = ProcessSection(CurrentCell)
SummarySheet.Cells(Rw, col).value = TotalValues
Rw = Rw + TotalValues
End If
Next Rw
Next col
End Sub
Function ProcessSection(FirstCellWithValue As Range) As Long
Dim Counter As Long: Counter = 0
Do Until FirstCellWithValue.Offset(Counter, 0).value <> FirstCellWithValue.value
Counter = Counter + 1
Loop
ProcessSection = Counter
End Function
As a small disclaimer, I haven't tested this, let me know if there are problems.
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
Ok I have tried these and grasped some view on variants and I have written these code
Sub main()
Dim Vary As Variant
Vary = Sheet1.Range("A1:D11").Value
For i = 1 To UBound(Vary)
For j = i + 1 To UBound(Vary)
If Vary(i, 1) = Vary(j, 1) Then
'I should delete the vary(j,1) element from vary
'in excel sheet we use selection.entirerow.delete
End If
Next j
Next i
End Sub
This is the sample I tried
A B C D
1 somevalues in BCD columns
2
3
1
Now Delete the 4th row don think I'm working for unique records I'm just learning stuff to do and while I was learning variant I am stuck at this point deleting a complete row stored in variant
I have stored (A1:D11).value in variant
Now how can I delete the A6 element or row in variant so that I can avoid it while I copy the variant to some other sheet?
Can I also delete the C AND B columns in variant so that when i do transpose it wont copy the C and B columns?
I don't know what exactly a variant is - I was thinking to take a set of range and do operations like what we do for an excel sheet then take that variant and transpose it back to sheet.
Is that the right way of thinking or did I misunderstand the use of variants?
`variant(k,1)=text(x)` some array shows mismatch ? whats wrong?
If you are planning on using a varray to look at cells in each row to decide if you should delete the row or not, you should loop through your varray backwards, the same way you would if you did a for loop through the cell range. Since you are starting on row 1, the variable i will always equal the row number the element was located on, so you can use that to delete the proper row.
Here's a sample (more simple than what you are trying to do, though) that will delete each row in which the cells in columns A and B are the same.
Sub test()
Dim varray As Variant
varray = Range("A1:B11").Value
For i = UBound(varray, 1) To 1 Step -1
If varray(i, 1) = varray(i, 2) Then
Cells(i, 1).EntireRow.Delete
End If
Next
End Sub
Notes of interest:
UBound(varray, 1) gives the count of the rows
UBound(varray, 2) gives the count of the columns
One workaround without a second array is to introduce a deliberate error into an element you want to replace, then use SpecialCells to delete the cell after dumping the variant array back over the range. This sample introduces an error into the array position corresponding to A6 (outside the loop as its an example), then when the range is dumped to E1, the SpecialCell error removal shifts F6:H6 into E6:G6. ie
pls save before testing - this code will overwrite E6:H11 in the first worksheet
Sub main()
Dim Vary As Variant
Dim rng1 As Range
Set rng1 = Sheets(1).Range("A1:D11")
Set rng2 = rng1.Offset(0, 4)
Vary = rng1.Value2
For i = 1 To UBound(Vary)
For j = i + 1 To UBound(Vary)
'your test here
Next j
Next i
Vary(6, 1) = "=(1 / 0)"
With rng2
.Value2 = Vary
On Error Resume Next
.SpecialCells(xlFormulas, xlErrors).Delete xlToLeft
End With
End Sub