Posts by Barrie Davidson
Please note that on 14th December 2023 users will experience an expected outage whilst we make upgrades to our network. We anticipate this process may take a couple of hours and so we apologise in advance for any inconvenience.
-
-
-
Re: Delete non-numeric characters (like symbols) from cells
Are you numbers all formatted the same? i.e., like (###) ###-####
-
Re: Change in data; comparing 2 workbooks
That should be four lines not 3. Make sure it's
CodeComparison.Formula = "=INDEX([" & LastMonth.Name & _ "]OPTY fActMgr gGTM Excel!" & LookupRange.Offset(, -6).Address & ",MATCH(L2,[" & _ LastMonth.Name & "]OPTY fActMgr gGTM Excel!" & LookupRange.Address & ",0))" Comparison.Value = Comparison.Value
and not
-
Re: Change in data; comparing 2 workbooks
This works okay for me, let me know your results.
Code
Display MoreSub Kallia() 'Written by Barrie Davidson Dim FileToOpen As Variant Dim LastMonth As Workbook Dim LookupRange As Range Dim Comparison As Range Application.ScreenUpdating = False FileToOpen = Application.GetOpenFilename("Excel files (*.xls),*.xls", , "Select last month's file") If FileToOpen = False Then Exit Sub With Sheets("Data") Set Comparison = .Range("M2:M" & .Range("L65536").End(xlUp).Row) End With Workbooks.Open FileToOpen Set LastMonth = ActiveWorkbook With Sheets("Data") Set LookupRange = .Range("L2:L" & .Range("L65536").End(xlUp).Row) End With Comparison.Formula = "=INDEX([" & LastMonth.Name & _ "]Data!" & LookupRange.Offset(, -6).Address & ",MATCH(L2,[" & _ LastMonth.Name & "]Data!" & LookupRange.Address & ",0))" Comparison.Value = Comparison.Value Comparison.TextToColumns DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _ Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _ :=Array(Array(1, 9), Array(2, 1)) LastMonth.Close False Comparison.Offset(, 1).Value = Comparison.Offset(, -7).Value Comparison.Offset(, 1).TextToColumns DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _ Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _ :=Array(Array(1, 9), Array(2, 1)) Comparison.Offset(, 2).Formula = "=IF(AND(N2-M2>0,N2<=0.2),TRUE,FALSE)" Comparison.Offset(-1, -12).Resize(Comparison.Rows.Count + 1, 15). _ AutoFilter Field:=15, Criteria1:="TRUE" Comparison.Offset(-1, -12).Resize(Comparison.Rows.Count + 1, 12). _ SpecialCells(xlCellTypeVisible).Copy _ Destination:=Sheets("Developping Opportunities ").Range("A1") Comparison.Offset(, -12).Resize(, 15).AutoFilter Comparison.Resize(, 3).ClearContents Application.ScreenUpdating = True End Sub
-
Re: Macro keyboard shortcuts
So the code just ends, no error messages?
-
Re: Macro keyboard shortcuts
What's the shortcut you designated? Can you post your code and indicate where it stops?
-
Re: Extract a block range from a street address and remove a community from a string
Quote from mredwzI will have to do this for about 6500 entries a month so it will have to drop down on cell at a time,until the last entry.
No need! Just select all the cells you want to do this to and then do your "find and replace" followed by the parsing.
-
Re: Delete block of rows
The macro will delete five rows if it finds an exact match for "QWD" (as per your first posting). Please clarify your data (I'm guessing that the cell begins with "QWD"?).
-
Re: Extract a block range from a street address and remove a community from a string
I would suggest you:
• Do a find and replace (CTRL+H) for the quote marks. Find the quote and replace with nothing.
• Do another find replace for the dash mark (this assumes you always have a space after the dash and the block numbers have no space between the dash). In the find box put "- *" (not including the quote marks) and put nothing in the replace box.
• Then parse the data using TextToColumns and select space as your delimiter.Please post back your results or if you have any further questions.
Regards,
-
Re: Delete block of rows
Welcome to the Board.
Is it always five rows you're going to delete? If yes, you could use (note this searches the entire activesheet for "QWD"):
-
Re: Macro to save csv to xls
The code should work on the active workbook. Where is it stopping?
-
-
-
Re: Print Hidden Dynamic Worksheet
Quote from beekerNow I do have in Page setup, to print line $1:$6 on each page (column headers)
Given that, I would change
CodeSheets("Pricing").PageSetup.PrintArea = "$A$1:$H$" & _ Sheets("Costing").Range("B65536").End(xlUp).Row
to readCodeSheets("Pricing").PageSetup.PrintArea = "$A$7:$H$" & _ Sheets("Costing").Range("B65536").End(xlUp).Row
I am not clear on the rest of your problem. Based on the sample posted, you would only print to row 10 (determined by Costing) while you've got data in your Pricing workbook going to row 13. Can you clarify this for me?
-
-
Re: Why is the .select method failing?
The sample workbook you posted didn't contain "Ord Time" in any worksheet. That's why you can't select it - it doesn't exist.
-
-
Re: column duplicates / merge data formula and/or macro???
Will this work?
Code
Display MoreSub DazeDays() 'Written by Barrie Davidson Dim WorkingSheet As Worksheet, NewSheet As Worksheet Dim DataRange As Range, NewRange As Range Dim EvalRange1 As String, EvalRange2 As String Application.ScreenUpdating = False Set WorkingSheet = ActiveSheet Set DataRange = Range("A1:C" & Range("A65536").End(xlUp).Row) Sheets.Add Set NewSheet = ActiveSheet DataRange.Resize(, 1).Copy Destination:=NewSheet.Range("A1") Set NewRange = Range("A1:A" & Range("A65536").End(xlUp).Row) NewRange.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("B1"), _ Unique:=True Columns("A:A").Delete Shift:=xlToLeft Set NewRange = Range("A1:A" & Range("A65536").End(xlUp).Row) Range("B1").Value = "Number" Range("C1").Value = "Type" Range("D1").Value = "Home" Range("E1").Value = "Work" Range("F1").Value = "Fax" Range("G1").Value = "Other" Range("H1").Value = "Radio" EvalRange1 = "'" & DataRange.Worksheet.Name & "'!" & DataRange.Resize(, 1).Address EvalRange2 = "'" & DataRange.Worksheet.Name & "'!" & DataRange.Offset(, 2).Resize(, 1).Address NewRange.Offset(1, 3).Resize(NewRange.Rows.Count - 1, 5).Formula = _ "=IF(SUMPRODUCT((" & EvalRange1 & "=$A2)+0,(" & _ EvalRange2 & "=D$1)+0,ROW(" & EvalRange1 & "))=0" & _ ",""n/a"",INDIRECT(""'" & DataRange.Worksheet.Name & _ "'!B""&SUMPRODUCT((" & EvalRange1 & "=$A2)+0,(" & _ EvalRange2 & "=D$1)+0,ROW(" & EvalRange1 & "))))" NewRange.Offset(1, 3).Resize(NewRange.Rows.Count - 1, 5).Copy NewRange.Offset(1, 3).Resize(NewRange.Rows.Count - 1, 5). _ PasteSpecial xlPasteValues Application.CutCopyMode = False Range("A1").Select Application.ScreenUpdating = True End Sub
-