I have a matrix with lots of rows which do have different row lengths. As you can see in the image below, row 3 ends at column T, whereas row 8 ends at column L. What I am trying to do is to loop through every row of the matrix with the fleet name "Taxi" and sum up every entry.
How can I accomplish this? The main problem I face is with iterating through the rows and finding the end of the row dynamically and how to filter the table beforehand by the fleetname.
Code does what you want
Dim sht As Worksheet
Dim LastColumn As Long
Dim LastRow as Long
Dim i as Long
Dim dblSum as Double 'your sum
Set sht = ThisWorkbook.ActiveSheet
With sht
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i=2 to LastRow
If .Cells(i,1).Value = "Taxi" Then
LastColumn = .Cells(i, .Columns.Count).End(xlToLeft).Column
dblSum = Application.Sum(.Range(.Cells(i, 2), .Cells(i, LastColumn)))
End if
Next i
End with
Set sht = Nothing
Related
I am trying to populate each row of a column with 1 from the 2nd row after the header to the last row.
The column is "Ok to call" in a worksheet named Adults.
This code creates the column in the correct worksheet that I need but does not populate the rows with 1. I believe I have to add in the last row but don't know how. Appreciate any help!
Dim shtA As Worksheet
Set shtA = ActiveWorkbook.Sheets("Adults")
Dim LastCol As Long
LastCol = shtA.Cells(1, Columns.Count).End(xlToLeft).Column
Dim lastRow As Long
lastRow = shtA.Cells(Rows.Count, 1).End(xlUp).Row
'Loop through heading row to get column number of "Ok to call?"
Dim okcall As Long
Dim a As Long
For a = 1 To LastCol
If LCase(shtA.Cells(1, a).Value) = "ok to call?" Then
okcall = a
Exit For
End If
Next a
Added this after PeterT's suggestion:
For a = 1 + 1 To lastRow
shtA.Cells(a, okcall).Value = 1
Next a
End
So I've got an Excel workbook with multiple worksheets. Each worksheet is the same template. And cells B3 - B39, C3 - C39, and D3 - D39 will contain 1 of 3 values. 1, .5, or no value at all (completely blank). Now each worksheet isn't exactly the same (some will go to B/C/D45 instead of just B/C/D39). I'm trying to have another cell show how many of those cells contain a 1, and another cell show how many contain a .5. Yeah I could manually do it, but I'm trying to get this as automated as possible.
As #Variatus has suggested, you could just use the COUNTIF worksheet function, but if you wanted to do this with VBA, what you need to do is:
Method
Identify the last row
Build the range
Count how many of the cells in this range contain 1
Count how many of the cells in this range contain .5
Do something with these counts
Code
Sub CountTheSheets()
Const Value10 As Double = 1, Value05 As Double = 0.5 ' these are what we're comparing cell values against
Dim Count10 As Long, Count05 As Long ' these are our 1 and .5 counts respectively
Dim lastRow As Long, lastRowTemp As Long, maxRow As Long
Dim ws As Worksheet
Dim cel As Range
For Each ws In ThisWorkbook.Worksheets ' iterate over all worksheets
lastRow = 0 ' reset the last row for this worksheet
Count10 = 0 ' reset the 1 count for this worksheet
Count05 = 0 ' reset the .5 count for this worksheet
With ws
maxRow = .Rows.Count ' this is the absolute bottom row in a worksheet
' get last row of column B, by going to the bottom of the worksheet in that column, then using End and going up to find the last cell
lastRowTemp = .Cells(maxRow, "B").End(xlUp).Row
If lastRowTemp > lastRow Then lastRow = lastRowTemp
' get last row of column C; if larger than the previous, store in lastRow that row number instead
lastRowTemp = .Cells(maxRow, "C").End(xlUp).Row
If lastRowTemp > lastRow Then lastRow = lastRowTemp
' get last row of column D; if larger than the previous, store in lastRow that row number instead
lastRowTemp = .Cells(maxRow, "D").End(xlUp).Row
If lastRowTemp > lastRow Then lastRow = lastRowTemp
' build the range using lastRow, and iterate through the cells in that range, counting the matching values
For Each cel In .Range("B3:D" & lastRow)
If cel.Value = Value10 Then
Count10 = Count10 + 1
ElseIf cel.Value = Value05 Then
Count05 = Count05 + 1
End If
Next cel
' do something with these counts
Debug.Print .Name, Count10, Count05
End With
Next ws
End Sub
I have different data on multiple rows and columns in Excel and I want all the data to be on a single Column. I tried the Transpose Function but it's not helping me to get what I want.
This is what I have right now:
And this is what I want to get:
Can anyone kindly tell me how I can achieve that? Any built in function or Macro will be helpful. Thanks.
Try this code:
Sub RangetoColumn()
Dim LastRow As Long, LastColumn As Long
Dim CurrentSheet As Worksheet, TargetSheet As Worksheet
Dim i As Long, j As Long, Count As Long
Set CurrentSheet = ThisWorkbook.Worksheets("Sheet1")'-->change Sheet1 to your source sheet
Set TargetSheet = ThisWorkbook.Worksheets("Sheet2")'-->change Sheet2 to your target sheet
LastRow = CurrentSheet.Cells(Rows.Count, "A").End(xlUp).Row
Count = 1
For i = 1 To LastRow
LastColumn = CurrentSheet.Cells(i, Columns.Count).End(xlToLeft).Column
For j = 1 To LastColumn
TargetSheet.Range("A" & Count).Value = CurrentSheet.Cells(i, j).Value
Count = Count + 1
Next j
Next i
End Sub
Code will read Range from Sheet1 and will create a Column in Sheet2.
I think this tutorial should help you : tutorial
you can try that solution for your needs.
Try using & in both cells. Try like this A1&B1 to combine the data in cell A1 and cell B1; copy and paste, then enjoy.
this will have all current sheet cells listed down its column A and cleared all other adjacent columns
Option Explicit
Sub RangeToOneColumn()
Dim lastRow As Long, i As Long, j As Long
Dim rng As Range
Dim myArr As Variant
With ThisWorkbook.Worksheets("Sheet1") '<== change it to your needs
lastRow = .Cells(.rows.Count, "A").End(xlUp).Row
ReDim myArr(0 To lastRow - 1)
For i = 1 To lastRow
Set rng = .Range(.Cells(i, 1), .Cells(i, .Columns.Count).End(xlToLeft))
myArr(i - 1) = Application.Transpose(Application.Transpose(rng))
Next i
.Cells(1, 1).CurrentRegion.ClearContents
j = 1
For i = LBound(myArr) To UBound(myArr)
.Cells(j, 1).Resize(UBound(myArr(i))) = Application.Transpose(myArr(i))
j = j + UBound(myArr(i))
Next i
End With
End Sub
since it uses array, it runs faster than iterating a coping&pasting through cells
Trying to write a script to delete all cells in a row except the last used cell, then move all remaining data to the first column.
See below:
|--| is an empty cell
|XX| is a cell with unneeded data
|DATA| is the cell with Data I require.
Before:
|--|--|--|XX|XX|XX|XX|DATA|
|--|--|XX|XX|XX|DATA|
After
|DATA|
|DATA|
Assuming you meant in Excel:
Process:
Loop over the sheet
Set a tempVal variable to the value of the lastColumn
Loop through the columns to the last column for that row, clearing each cell
Set the value of column A to the tempVal
TESTED:
Sub GetLastColumnValue()
Dim lastRow As Long
Dim lastCol As Long
Dim sheet As String
Dim tempVal As String
sheet = "Sheet1"
lastRow = Sheets(sheet).Range("A" & Rows.Count).End(xlUp).row 'Using Range()
For lRow = 2 To lastRow
lastCol = Sheets(sheet).Cells(lRow, Columns.Count).End(xlToLeft).Column
tempVal = Sheets(sheet).Cells(lRow, lastCol).Text
For lCol = 1 To lastCol
Sheets(sheet).Cells(lRow, lCol).ClearContents
Next lCol
Sheets(sheet).Cells(lRow, 1) = tempVal
Next lRow
End Sub
This is my first time to code in VBA.
I have several worksheets in a file and they are in order by dates.
So what I am trying to do is to collect data sets in a worksheet if they have the same period of time.
date1 value1
date2 value2
date3 value3
Since they are in order I just compare the first date values and if they are different it moves on to the next worksheet. If they are the same then copy the value and do the same process until it reaches the last worksheet.
However it copies one worksheet fine but after that Excel freezes.
I would be appreciated if you find any errors or give me other suggestions to do it.
Following is my code:
Sub matchingStock()
Dim sh1 As Worksheet, sh2 As Worksheet
' create short references to sheets
' inside the Sheets() use either the tab number or name
Set sh1 = Sheets("combined")
Dim col As Long
'since first column is for Tbill it stock price should place from the third column
col = 3
Dim k As Long
'go through all the stock worksheets
For k = Sheets("WLT").Index To Sheets("ARNA").Index
Set sh2 = Sheets(k)
' Create iterators
Dim i As Long, j As Long
' Create last rows values for the columns you will be comparing
Dim lr1 As Long, lr2 As Long
' create a reference variable to the next available row
Dim nxtRow As Long
' Create ranges to easily reference data
Dim rng1 As Range, rng2 As Range
' Assign values to variables
lr1 = sh1.Range("A" & Rows.Count).End(xlUp).Row
lr2 = sh2.Range("A" & Rows.Count).End(xlUp).Row
If sh1.Range("A3").Value = sh2.Range("A3").Value Then
Application.ScreenUpdating = False
' Loop through column A on sheet1
For i = 2 To lr1
Set rng1 = sh1.Range("A" & i)
' Loop through column A on sheet1
For j = 2 To lr2
Set rng2 = sh2.Range("A" & j)
' compare the words in column a on sheet1 with the words in column on sheet2
'Dim date1 As Date
'Dim date2 As Date
'date1 = TimeValue(sh1.Range("A3"))
'date2 = TimeValue(sh2.Range("A3"))
sh1.Cells(1, col).Value = sh2.Range("A1").Value
' find next empty row
nxtRow = sh1.Cells(Rows.Count, col).End(xlUp).Row + 1
' copy the word in column A on sheet2 to the next available row in sheet1
' copy the value ( offset(0,1) Column B ) to the next available row in sheet1
sh1.Cells(nxtRow, col).Value = rng2.Offset(0, 6).Value
'when the date is different skip to the next worksheet
Set rng2 = Nothing
Next j
Set rng1 = Nothing
Next i
'sh3.Rows("1:1").Delete
Else
GoTo Skip
End If
Skip:
col = col + 1
Next k
End Sub
I cannot identify a specific error so this is a list of suggestions that may help you identify the error and may help improve your code.
Suggestion 1
Do you think the Else block of If-Then-Else-End-If is compulsory?
If sh1.Range("A3").Value = sh2.Range("A3").Value Then
:
Else
GoTo Skip
End If
Skip:
is the same as:
If sh1.Range("A3").Value = sh2.Range("A3").Value Then
:
End If
Suggestion 2
I do not like:
For k = Sheets("WLT").Index To Sheets("ARNA").Index
The value of property Index for a worksheet may not what you think it is. This may not give you the set or sequence of worksheets you expect. Do you want every worksheet except "Combined"? The following should be more reliable:
For k = 1 To Worksheets.Count
If Worksheets(k).Name <> sh1.Name Then
:
End If
Next
Suggestion 3
You use:
.Range("A" & Rows.Count)
.Range("A3")
.Cells(1, col).Value
.Cells(Rows.Count, col)
rng2.Offset(0, 6)
All these methods of identifying a cell or a range have their purposes. However, I find it confusing to use more than one at a time. I find .Cells(row, column) and .Range(.Cells(row1, column1), .Cells(row2, column2)) to be the most versatile and use them unless there is a powerful reason to use one of the other methods.
Suggestion 4
I cannot decypher what this code is attempting to achieve.
You say: "I have several worksheets in a file and they are in order by dates. So what I am trying to do is to collect data sets in a worksheet if they have the same period of time."
If you have set Worksheet("combined").Range("A3").Value to a particular date and you want to collect data from all those sheets with the same value in cell A3 then the outer For-Loop and the If give this effect. But if so, if does not matter how the worksheets are ordered. Also you start checking cell values from row 2 which suggests row 3 is a regular data row.
The outer loop is for each worksheet, the next loop is for each row in "combined" and the inner loop is for each row in the worksheet selected by the outer loop. The middle loop does not appear to do anything but set rng1 which is not used.
Perhaps you can add an explanation of what you are trying to achieve.
Suggestion 5
Are you trying to add an entire column of values from the source worksheets to "Combined". The macro below:
Identifies the next free row in column A of "Combined"
Identifies the last used row in column A of "Sheet2"
Assumes the first interesting row of "Sheet2" is 2.
Adds the entire used range of column A of "Sheet2" (complete with formatting) to the end of "Combined"'s column A in a single statement.
This may demonstrate a better way of achieving the effect you seek.
Sub Test()
Dim RngSrc As Range
Dim RngDest As Range
Dim RowCombNext As Long
Dim RowSrcFirst As Long
Dim RowSrcLast As Long
With Worksheets("Combined")
RowCombNext = .Cells(Rows.Count, "A").End(xlUp).Row + 1
Set RngDest = .Cells(RowCombNext, "A")
End With
With Worksheets("Sheet2")
RowSrcFirst = 2
RowSrcLast = .Cells(Rows.Count, "A").End(xlUp).Row
Set RngSrc = .Range(.Cells(RowSrcFirst, "A"), .Cells(RowSrcLast, "A"))
End With
RngSrc.Copy Destination:=RngDest
End Sub