I have a sheet with with orders and a timestamp.
I want to sort these rows based on the timestamp in the column on the right, but I want to keep their grouping position kind of. Like I want the 4 first rows to be sorted but stay in the 4 first row, then I want to sort row 8 and 9, but have them stay there.
I have managed to select both ranges, and leave out the "middle", but the .sort method will not work unless the key cells are in one range. So I thought maybe if I loop through the different ranges in the column or something like that.
Here is the code I have for now, thought I don't think it will make a difference.
Dim LR As Long, cell As Range, rng As Range
With Sheets("Ark1")
Dim start As Range
Set start = Range("N16")
LR = .Range("N" & Rows.Count).End(xlUp).Row
For Each cell In .Range("N16:N" & LR)
If cell.value <> "" Then
If rng Is Nothing Then
Set rng = cell
Else
Set rng = Union(rng, cell)
End If
End If
Next cell
rng.Sort key1:=start, order1:=xlAscending, Header:=xlGuess
End With
Well, the easiest way to achieve your goal is to re-numerate the rows in a custom order. For example you assign number #1 to the first groups of the rows, #2 to the second and so on. Then you just sort all the range by two columns, first would be your custom "order" and the second timestamp. :)
Assuming that each block is separated by blank values in column N, and that you want to sort the whole rows for each blocks, here is the code I suggest:
Public Sub testSort()
Dim firstRow As Long
Dim lastRow As Long
Dim blockStart As Long
Dim blockEnd As Long
Dim rng As Range
firstRow = 3
lastRow = Cells(Rows.Count, 14).End(xlUp).Row
blockStart = firstRow
Do
If Cells(blockStart + 1, 14) <> "" Then
blockEnd = Cells(blockStart, 14).End(xlDown).Row
Else
blockEnd = blockStart
End If
Set rng = Range(Rows(blockStart), Rows(blockEnd))
rng.Sort Key1:=rng.Cells(, 14), Order1:=xlAscending, Header:=xlNo
blockStart = Cells(blockEnd, 14).End(xlDown).Row
Loop Until blockEnd >= lastRow
End Sub
Related
Sub Add_Leading_Zeros()
Dim LastColumn As Integer
LastColumn = ActiveSheet.Cells(Columns.Count, 1).End(xlUp).Column
Dim LastRow As Integer
LastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
Dim HeaderRange As Range, HeaderCell As Range
Set HeaderRange = Range("A1:A" & LastColumn)
For Each HeaderCell In HeaderRange
If InStr(1, HeaderCell.Value, "Title") > 0 Or InStr(1, HeaderCell.Value, "title") > 0 Then
Dim TitleRange As Range, TitleCell As Range
Set TitleRange = 'range of that cell's used cells in that column
'Add Zeroes to front of number until total numbers = 4
End Sub
Above is a rough outline of what I'm aiming for. I want to have my macro scan a row and if any cells in that row match a word then I want to add 0's to the front of each cell in that column until each cell has a total of 4 numbers. Essentially adding leading zeros.
Am I on the right track? What can I do to look up solutions or learn? I would like help writing this code but I also want to understand the thought process behind the decisions so I can continue my learning.
Sub Add_Leading_Zeros()
Dim sht As Worksheet
Dim HeaderRange As Range, HeaderCell As Range, c As Range
Set sht = ActiveSheet
For Each HeaderCell In sht.Range(sht.Range("A1"), sht.Cells(1, Columns.Count).End(xlToLeft)).Cells
If LCase(HeaderCell) Like "*title*" Then
For Each c In sht.Range(HeaderCell.Offset(1, 0), _
sht.Cells(Rows.Count, HeaderCell.Column).End(xlUp)).Cells
If Len(c.Value) > 0 Then
c.NumberFormat = "#" 'Text
c.Value = Right("0000" & c.Value, 4)
End If
Next c
End If
Next HeaderCell
End Sub
If you want to add a leading zero to a cell:
cells(i,1).value = "0" & cells(i,1).value
The rest of your approach looks fine, in terms of what you're aiming to do... you've got quite a few issues with syntax, e.g., cells(1,columns.count) versus cells(rows.count,1).
I would say to be careful on the terms you're using to describe. You are looking down a column and different rows, from what I can read in your code, but your post talks about finding items in a row.
If you are going down a column, you can use application.match to help determine if you have anything matching cells above your current cell, similar to:
Dim i As Long, lr As Long
With Sheets(1)
lr = .Cells(Rows.Count, 4).End(xlUp).Row)
For i = 2 To lr
On Error Resume Next
If Application.Match(.Cells(i, 4), .Range(.Cells(1, 1), .Cells(lr, 1)), 0) > lr Then .cells(i,1).value = "0" & .cells(i,1).value
Next i
End With
I know you've answered similar topics which I have tried to duplicate, but I am a novice and apparently need the answer spelled out for me! I am trying to apply autofill code to a MAX formula column within a Macro, so that it will autofill to different row counts each time.
Range("AC2").Select
ActiveCell.FormulaR1C1 = "=MAX(RC[-2],RC[-1])"
Selection.AutoFill Destination:=Range("AC2:AC285")
Range("AC2:AC285").Select
Thank you!
It is only important to fill the formula down to the last value within the columns referenced within the formula.
dim lr as long
with worksheets("sheet1")
lr = application.max(.cells(.rows.count, "AA").end(xlup).row, _
.cells(.rows.count, "AB").end(xlup).row)
.Range("AC2:AC" & lr).FormulaR1C1 = "=MAX(RC[-2],RC[-1])"
end with
Assuming there are no blanks between the first and last row in column AC this will work and you don't even need AutoFill
With Range(Range("AC2"),Range("AC2").End(xlDown))
.FormulaR1C1 = "=MAX(RC[-2],RC[-1])"
End With
This works specifically becuase you are using R1C1 notation which can be applied across all cells.
If there may be blanks, you can find last row like below and fill the formulas the same way:
Dim lastRow as Long
lastRow = Range("AC" & Rows.Count).End(xlUp).Row
With Range("AC2:AC" & lastRow)
.FormulaR1C1 = "=MAX(RC[-2],RC[-1])"
End With
So you have two main tasks:
how to define last row in a given column;
how to define range, based on a row and column;
This is the answer both:
Option Explicit
Sub TestMe()
Dim currLastRow As Long
currLastRow = lastRow(columnToCheck:=4)
With Worksheets(1)
.Range("D1").FormulaR1C1 = "=MAX(RC[-2],RC[-1])"
.Range("D1").AutoFill Destination:=.Range(.Cells(1, "D"), .Cells(currLastRow, "D"))
End With
End Sub
Function lastRow(Optional wsName As String, Optional columnToCheck As Long = 1) As Long
Dim ws As Worksheet
If wsName = vbNullString Then
Set ws = ActiveSheet
Else
Set ws = Worksheets(wsName)
End If
lastRow = ws.Cells(ws.Rows.Count, columnToCheck).End(xlUp).Row
End Function
The lastRow function gives the last row per column. In your case, you want column D, e.g. the 4. column.
I am trying to find the number of rows of a filtered range on a sheet. LstRow2 is the variable I am trying to find. With this code I am getting the unfiltered number of rows.
CSht.Range(CSht.Cells(1, 1), CSht.Cells(LstRow1, LstCol1)).AutoFilter Field:=2, Criteria1:="RA"
With CSht
LstRow2 = .UsedRange.SpecialCells(xlCellTypeLastCell).Row
End With
You'll need to work with the visible cells only, since it's filtered.
Try this:
With CSht
'load filter cells into Range object
Dim rngFilter as Range
Set rngFilter = Intersect(.UsedRange,.UsedRange.Offset(1)).SpecialCells(xlCellTypeVisible)
'find the max number of elements split by $ in the range address
'needs to be dynamic because of areas
Dim lUpper as Long
lUpper = UBound(Split(rngFilter.Address,"$"))
'the last element will be the last row in the filtered range
'the last number in the rngFilter.Address
Dim LstRow2 as Long
LstRow2 = Split(rngFilter.Address,"$")(lUpper)
End With
Why don't you replace this line
LstRow2 = .UsedRange.SpecialCells(xlCellTypeLastCell).Row
With
LstRow2 = .Cells(.rows.count, 1).end(xlup).row
There may be several areas after filtering so you need to use Areas. Great explanation here https://stackoverflow.com/a/17287558/3733214. This should work:
Dim Line as Range
For Each Line In CSht.UsedRange.SpecialCells(xlCellTypeVisible).Areas
LstRow2 = LstRow2 + Line.Rows.Count
Next
Credits: https://www.mrexcel.com/board/threads/vba-code-to-count-visible-rows-after-autofiltering-a-table.602866/post-2988416
This formula lastRow = Worksheets("Sheet1").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row has given me the the correct last visible row of a filtered range.
Current region will do it for you in a single line
LastRow = sht.Range("A1").CurrentRegion.Rows.Count
I am trying to find values that occur more than once in Column 1, then get their MIN corresponding values from column 3. So for example if column 1 has 3 matching values of 124L, and their corresponding values in column 3 is 120, 90 and 60, then overwrite column 3 of the matching values with the 60. So at the end of the day all my 124L should have 60 in Column 3.
I would appreciate any help or direction, am currently stumped especially on the searching for multiple matching values. Thank you. Below is the code which am ashamed to even post...
Sub minFinder()
'declare variables
Dim minCartMx As Long, multiLocsCartMxFound As Long
Dim searchMultiLocs As Range, foundMultiLocs As Range
Dim FinalRow As Long
FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To FinalRow
'search multiple occurances of values in column 1
Set searchMultiLocs = Cells(i, 1)
For Each searchMultiLocs In searchMultiLocs
'I dont think this works but am trying to get values of corresponding
'to foundMultiLocs in column 3 (cells(i,3)
Set multiLocsCartMxFound = searchMultiLocs.Find(what:=searchMultiLocs,
LookIn:=xlWhole, _ searchorder:=xlByRows, searchDirection:=xlNext, _
MatchCase:=False, searchformat:=False)
'determine the minumum value of column 3 of the foundMultiLocs
minCartMx = Application.WorksheetFunction.Min(multiLocsCartMxFound)
' overwrite the column 3 of the matching values with MIN
minCartMx = Cells(i, 3)
End Sub
enter code here
Find only returns a single cell. Use Evaluate instead to find the minimum value. This example returns the minimum value from column C where column A is "value".
minValue = Application.Evaluate("min(if(A1:A10 = ""value"", C1:C10, """"))")
Also, on the last line of your code, your operands are flipped. You meant to write Cells(i,3) = minCartmx
In Vba:
Sub minFinder()
Dim ws As Worksheet
Dim rng As Range
Dim minRng As Range
Dim cel As Range
Set ws = Sheets("Sheet5") 'Change to your sheet
With ws
Set rng = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp))
Set minRng = .Range(.Cells(2, 3), .Cells(.Rows.Count, 3).End(xlUp))
End With
For Each cel In rng
cel.Offset(, 2).Value = ws.Evaluate("=MIN(IF(" & cel.Address(0, 0) & "=" & rng.Address(0, 0) & "," & minRng.Address(0, 0) & "))")
Next cel
End Sub
But you could easily do this with the formula from the code only.
in an empty column put:
=MIN(IF(A2=$A$2:$A$7,$C$2:$C$7))
This is an array formula and must be confirmed with ctrl-Shift-Enter.
Then it is just a matter of copying and pasting the values.
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