I have autosorted two of my rows using VBA in excel.
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Not Intersect(Target, Range("C:D")) Is Nothing Then
Range("C3").Sort Key1:=Range("C4"), _
Order1:=xlAscending, _
Key2:=Range("D4"), _
Order2:=xlAscending, _
Header:=xlYes, _
OrderCustom:=2, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End Sub
I have auto sorted column C and D in ascending order.
But when i merge 2 cells in Column J (i.e. J53 and J54) the auto sorting does not work for the Column C and D or the entire sheet we can say.
I want to merge the cells in Column J as well as make Column C and D auto sort using VBA.
NB: similarly i want to sort to 2 cells in Column K as well.
Sorting does not work with merged cells. Except when all merged cells are the same size.
I highly recommend not to use On Error Resume Next without proper error handling. It just makes you blind to any errors but they still occur, you will just never know because the message is suppressed.
That is also why you didn't see the error message telling you exactly this! Remove On Error Resume Next and you will see the error message!
Solution
You can unmerge the cells to sort them, or use a 3ʳᵈ party tool like Kutools: How To Sort Data With Merged Cells In Excel?
Note that this is not the only case why merged cells are evil. Therefore I recommend not to use merged cells at all.
I would unmerge the cells, then sort and then merge again...
Related
Aplication Defined error Copying a specified column and range including blanks with an embedded button running multiple Macros. I know that all rows will be filled in column A so if I could reference the rest of the Macros to A.end
I've looked Google youtube and here although there is a lot of info on copying and pasting, I cannot find one that works for this running multiple Macros.
Macros 5 & 6 is where I start having problems because these columns have multiple blanks throughout.
Raw data to Copy:
Destination:
Private Sub CommandButton1_Click()
Worksheets("Sheet1").Range("a2", Range("a2").End(xlDown)).Copy _
Worksheets("Sheet2").Range("a2") 'macro1
Worksheets("Sheet1").Range("d2", Range("d2").End(xlDown)).Copy _
Worksheets("Sheet2").Range("b2") 'Macro2
Worksheets("Sheet1").Range("c2", Range("c2").End(xlDown)).Copy _
Worksheets("Sheet2").Range("c2") 'macro3
Worksheets("Sheet1").Range("g2", Range("g2").End(xlDown)).Copy _
Worksheets("Sheet2").Range("d2") 'macro4
If Worksheets("Sheet1").Range("e2", Range("e2").End(xlDown)).Value = "<0" Then
Worksheets("Sheet2").Range("i2").Copy 'macro5
If Worksheets("Sheet1").Range("e2", Range("e2").End(xlDown)).Value = ">0" Then
Worksheets("Sheet2").Range("j2").Copy 'macro6
Worksheets("Sheet2").Activate 'macro7
Range.end(xldown) only gets you a contiguous range (effectively it will stop at the first blank cell).
Since you want to include blanks, you might want to instead work from the last row of your worksheet back up to the first non-blank cell encountered in that column (which is a way of getting the last row).
This would mean something like:
' If you are new to With statements (below), any objects within the With block that begin with a . relate to "Sheet1". Saves us typing Sheet1 repeatedly, and makes sense to use it since we access a lot of Sheet1's members like range/cells/rows
With Worksheets("Sheet1")
.Range("a2", .cells(.rows.count, "A").End(xlup)).Copy Worksheets("Sheet2").Range("a2") 'macro1
End with
Untested, written on mobile -- but hope it works or gets you closer to a solution. You would need to copy-paste the above and change the A to B, C, D, E, etc. I wasn't too sure what you're trying to achieve with the "<0" condition in macro 5 and 6.
(It would better if you turned the code into a parameterised Sub and just provide the column letter/number as an argument to the sub, but just depends how new you are to VBA and programming in general -- and for the time being whatever is easier for you to understand/maintain.)
Edit regarding macro 5 and 6
With Worksheets("Sheet1")
Dim cell as range
For each cell in .Range("E2", .Cells(.Rows.Count, "E").End(xlUp))
If cell.Value <= 0 Then 'Get rid of the equal sign if you don't want it in your logic/condition'
Cell.Copy Worksheets("Sheet2").cells(cell.row, "I") 'Macro5
ElseIf cell.value > 0 Then
Cell.Copy Worksheets("Sheet2").cells(cell.row, "J") 'Macro6
End If
Next cell
End With
Worksheets("Sheet2").Activate 'macro7
I am trying to make a macro button that will automatically select column H and then search and select one by one in an array(one every time I click the macro) every cell in that specific column, that contains the € symbol. I can do that exactly as I want manually using the native excel search function but it is time consuming. Yet I don't know how to do that in VBA. Note that the cells in column H are currency formatted..The code that almost works for me so far is this:
Search = InStr(ActiveCell.NumberFormat, Chr(128))
Selection.Find(What:=Search, After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
BUT the above code doesn't automatically select column H for search. I have to do that manually. When i insert in the above code Columns("H").Select (in order to make the code select the column H automatically) the macro selects the first cell that contains the € symbol in the column H (which is what i want) BUT when clicking again it does not go to the NEXT cell that contains the € symbol in that column. It sticks on the first finding. Could you please help me?
You should always avoid using Selection. or .Select.
Instead of Selection.Find specify the correct range:
Worksheets("MySheetName").Columns("H").Find
Also have a look at the Range.FindNext Method (Excel). With find you will always find the first occurrence only. For further searches you will need to use FindNext.
I am not sure what do you want to achieve, but if you need to find cells formatted as Currency, I would rather use this code:
Sub findCur()
Dim rngCol As Range
Set rngCol = Range("H:H")
With Application.FindFormat
.Clear
.NumberFormat = "$#,##0.00"
End With
rngCol.Find(What:="*", After:=ActiveCell, SearchFormat:=True).Select
End Sub
Add a condition to the selection, something like:
If Selection.Column<>7 then Columns("H").select
This way if you are already in column H, it won't reselect it, but if you are not there, it will go there.
I am trying to get a raw Excel file into a customized format. I added a picture below, so its easier to explain. I will address the requirements as steps too.
1) I need to get rid off all columns which include "Importo" or "Prezzo"
2) I need to extract the date from the remaining columns (Quantitá). First, I insert an empty row on top and then i apply right(cell,7).
So far, so good.
Then I want to autofill the remaining columns, but i get a 1004 error. In the example code I tried from J:O, but really id need it from J to the last column. I post the code (which works until the last row).
I was actually wondering if Autofilling is best practise here, maybe indexing though would be better?
Sub delete_col()
Dim A As Range
Do
Set A = Rows(1).Find(What:="Importo", LookIn:=xlValues, lookat:=xlPart)
If A Is Nothing Then Exit Do
A.EntireColumn.Delete
Loop
Do
Set A = Rows(1).Find(What:="Prezzo", LookIn:=xlValues, lookat:=xlPart)
If A Is Nothing Then Exit Do
A.EntireColumn.Delete
Loop
Rows("1:1").Select
ActiveCell.EntireRow.Insert
ActiveCell.Range("J1").Select
ActiveCell.FormulaR1C1 = "=RIGHT(R\[1\]C,7)"
Selection.AutoFill Destination:=ActiveCell.Range("J1:O1"), Type:=xlFillDefault
End Sub
I suppose that in the line ActiveCell.FormulaR1C1 = "=RIGHT(R\[1\]C,7)", the \ is a kind of typo, which should be deleted.
Concerning the 1004 error, the easiest way to go around it, while doing AutoFill, is something like this:
Sub TestMe()
Range("A1:O1") = Range("J1")
End Sub
Thus, every value in Range("A1:O1") will be set with the value from Range("J1").
However, your code uses a lot of Select, Activate and ActiveCell. Try to avoid these, because they are not considered good practices in VBA and may lead to different errors. How to avoid using Select in Excel VBA
I got an spread sheet that include formulas and I wrote a vb code to value paste.
Depending on the input file number of rows that filled is varied and I need to delete the rows those had formulas and now empty. (This is using as connector and otherwise it some how pick these extra rows which is unnecessary)
Sheet2.Range("G2:G298").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Above code not doing anything...
If the blanks are results of a formula like:
=""
Entered into a cell and then copied and paste as values, those are not really blank cells.
Instead, those are cells that looks blank but contains zero length strings.
SpecialCells(xlCellTypeBlanks) and even Excel formula ISBLANK won't work on it.
One way is to loop through the range and check all that contains "" and delete it.
Dim c As Range, rngtodelete As Range
For Each c In Sheet2.Range("G2:G298")
If Len(c.Value) = 0 Then
If rngtodelete Is Nothing Then Set rngtodelete = c _
Else Set rngtodelete = Union(rngtodelete, c)
End If
Next
If Not rngtodelete Is Nothing Then rngtodelete.EntireRow.Delete xlUp
Another way is using AutoFilter like this:
Sheet2.Range("G2:G298").AutoFilter 1, "="
Sheet2.Range("G2:G298").SpecialCells(xlCellTypeVisible).EntireRow.Delete xlUp
I'm assuming that G2 does not contain your header but the start of your data.
If it happens to be your header, you'll need to use offset when deleting.
Sheet2.Range("G2:G298").Offset(1, 0) _
.SpecialCells(xlCellTypeVisible).EntireRow.Delete xlUp
Sheet2.AutoFilterMode = False
I'm not completely sure what you mean by "This is using as connector", but I believe it has to do with an export/import process to another application.
As mentioned, a zero length string is not the same as a truly blank cell. However, you can rid your worksheet of them easily. The fastest method I am aware of is a quick cyclic run through all of the columns, applying Text-to-Columns ► Fixed width ► Finish to each.
When that is done, the zero length strings will be reverted to truly blank cells but the worksheet's used range will still overlap those empty cells found at the bottom of the dataset. This means that any export to an external program will try to export those cells. Just run .UsedRange to get Excel to reevaluate the actual used range.
First, tap Ctrl+End to see what Excel thinks is the last used cell on the worksheet. Next, run the following macro.
Sub prep_for_export()
Dim c As Long
Debug.Print Sheets("Sheet1").UsedRange.Address(0, 0)
With Sheets("Sheet1")
For c = 1 To .Cells(1, Columns.Count).End(xlToLeft).Column
.Columns(c).TextToColumns Destination:=.Cells(1, c), _
DataType:=xlFixedWidth, FieldInfo:=Array(0, 1)
Next c
End With
Sheets("Sheet1").UsedRange
Debug.Print Sheets("Sheet1").UsedRange.Address(0, 0)
End Sub
Edit Sheet1 in all four places if you have to before running it.
That is a little homogeneous but I think it should work for your purposes. After running the macro, tap Ctrl+End back at your worksheet again to see what Excel thinks is the last used cell on your worksheet. The before and after range addresses were recorded to the VBE's Immediate window as well.
I appreciate there are a lot of similar questions out there but I've been searching various forums for three days now and not yet found anything which does what I need - so either I'm doing something very strange or my searching skills aren't up to scratch!
I'd really appreciate it if someone could let me know where I'm going wrong, or even link me to a solution which might help as I haven't managed to find one.
I currently have a spreadsheet with six worksheets. Worksheets 2-6 contain data on items which have been sold from different sources. Worksheet 1 currently contains four columns which populate the item data using a macro I've cobbled together into four separate columns. Worksheet 2 contains an 'itemlist' column into which I want to copy the data from each of the four columns in worksheet 2.
I hope this makes sense. At the moment, the code I have is below:
Sub UpdateList()
'Clear the current ranges
Range("PharmacyItems").Clear
Range("PrelabelItems").Clear
Range("RestockItems").Clear
Range("TakehomeItems").Clear
Range("FullItemList").Clear
'Populate control with unique list
Range("PharmacyFullList").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("PharmacyItems"), Unique:=True
Range("PrelabelFullList").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("PrelabelItems"), Unique:=True
Range("RestockFullList").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("RestockItems"), Unique:=True
Range("TakehomeFullList").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("TakehomeItems"), Unique:=True
'Combine the four ranges into one
Range("UniqueLists!$A:$A, UniqueLists!$B:$B, UniqueLists!$C:$C, UniqueLists!$D:$D").Copy Sheets("Drug totals").Range("A2")
'Sort the data
Range("FullItemList").Sort Key1:=Range("FullItemList").Columns(1), Order1:=xlAscending, Orientation:=xlSortColumns, Header:=xlYes, SortMethod:=xlPinYin, DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, DataOption2:=xlSortNormal
End Sub
In order to clarify the above, here is a definition of which range is which:
PharmacyItems, PrelabelItems, RestockItems and TakehomeItems: these are the individual lists which contain the unique items copied from each data worksheet.
FullList: the fulllist of the above four are the source data lists which are not unique lists
FullItemList: the column into which I want all the data from the unique lists to end up
The reason I have a range which specifies each column rather than using a named range is that I was trying to see if this would make it any better as originally it was just giving me a vague and fluffy range issue error. With the columns defined in the range it tells me the size/shape of the destination doesn't match the source.
The exact error is:
Run-time error '1004':
The information cannot be pasted because the Copy area and the paste area are not the same size and shape. Try one of the following:
- click a single cell, and then paste
- select a rectangle that's the same size and shape, and then paste
Can anyone help me? Sadly I'm a SQL Server girl, I'd far rather be pulling data from a database but I'm not allowed on this one!
Thank you in advance
Summer
You can't paste an entire column to a range starting on row 2 (or any other row than 1) because then the last row(s) of the column won't fit on the sheet. That's why Excel says "the Copy area and the paste area are not the same size".
Instead of
Range("UniqueLists!$A:$A, UniqueLists!$B:$B, UniqueLists!$C:$C, UniqueLists!$D:$D").Copy Sheets("Drug totals").Range("A2")
try pasting it starting on the first row.
Range("UniqueLists!A:D").Copy Sheets("Drug totals").Range("A1")
But I'm guessing you don't have data all the way down to the very bottom of your "UniqueLists" sheet? If so, then why are you copying the entire column? Just copy the part you need. Then you'll be able to paste starting on cell "A2". Example:
Range("UniqueLists!A1:D1234").Copy Sheets("Drug totals").Range("A2")
If you don't need the individual unique lists but just want to create a single column of all the unique values then this should work for you (untested though...)
Sub UpdateList()
Range("FullItemList").Clear 'Clear the full item list range
'Populate control with unique list
UniquesToFullItemList Range("PharmacyFullList")
UniquesToFullItemList Range("PrelabelFullList")
UniquesToFullItemList Range("RestockFullList")
UniquesToFullItemList Range("TakehomeFullList")
'Sort the data
Range("FullItemList").Sort Key1:=Range("FullItemList").Columns(1), _
Order1:=xlAscending, Orientation:=xlSortColumns, Header:=xlYes, _
SortMethod:=xlPinYin, DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, _
DataOption2:=xlSortNormal
End Sub
Sub UniquesToFullItemList(rngFrom As Range)
rngFrom.AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Sheets("Drug totals").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0), _
Unique:=True
End Sub