Posts by Luke M

**Luke M** · May 1st 2017

Re: VBA Help needed to tweak my Search and Find macro...

like this?

Code

Sub FindInLists()
     '
     ' Select FindInLists Macro
     '
     
    Dim SheetsToSearch
    Dim x As String
    Dim ws As Worksheet
    Dim r As Range
    Dim strKeyword As String
    
    SheetsToSearch = Array("List1", "List2", "List3") '// Enter the exact sheet names of sheets to be searched
     
    x = InputBox("What do you want to search for?", "Search")
    
    If x = "" Then
        'User cancelled
        Exit Sub
    End If
    
    For Each ws In ThisWorkbook.Sheets
        If Not IsError(Application.Match(ws.Name, SheetsToSearch, 0)) Then
            With ws.Range("A1:AB5000")
                Set r = .Find(what:=x, After:=.Range("A1")) 'find the cell whose value is equal to x and activate it
                If Not r Is Nothing Then
                    ws.Activate: r.Activate
                    Exit Sub
                End If
            End With
        End If
    Next
     
End Sub

Display More

**Luke M** · Apr 26th 2017

Re: Change values to the right of a decimal point

You'd need a second piece of info, as either way you need someone of knowing if the input was just lbs, or lbs + oz. Let's say there was some indication in B2, you could do:

=INT(A2)&"lb "&INT(MOD(A2,1)*IF(A2="Mixed", 100, 16))&"oz"

So, if user inputs a mixed value (lbs + oz), then we change 140.15 into 140lbs 15oz. If user selects "single" (or whatever else you pick), formula outputs 140lbs 2oz (if you want 2.4 oz, remove the INT function on latter part)

Edit: For clarity, I'd probably setup your data input to have two cells clearly marked, one for "Pounds" and the other for "Ounces", and then user can choose one or the other, or both. Then your unit conversions will be a lot easier.

**Luke M** · Apr 26th 2017

Re: Change values to the right of a decimal point

You could do something like this:

=INT(A2)&"lb "&INT(MOD(A2,1)*16)&"oz"

**Luke M** · Apr 17th 2017

Re: VBA code for PivotTable in Mac environment

Any MAC users out there?

**Luke M** · Apr 13th 2017

Hello all,

I've written this script to loop over all the PivotTables in a workbook. Goal is that user can input a year, and all the tables will go to that selected year. I had previously been using a Slicer, but that doesn't appear to work on a Mac (client is using Excel 2015). I don't own a Mac, so I haven't been able to test in the environment. Anyway, this latest bit of code appears to be running for user, but the tables aren't getting updated. Any ideas?

Code

Sub UpdateAllPivots()
    Dim pField As PivotField
    Dim pItem As PivotItem
    Dim myVal As String
    Dim pt As PivotTable
    Dim ws As Worksheet
    
    myVal = InputBox("What year to look at?", "Choose year", Year(Date))
    
    Application.ScreenUpdating = False
    
    For Each ws In ThisWorkbook.Worksheets
        For Each pt In ws.PivotTables
            pt.ManualUpdate = False
            Set pField = pt.PivotFields("Years")
            With pField


                If pfExists(myVal, pField) Then
                    .CurrentPage = myVal
                Else
                    .CurrentPage = .PivotItems(.PivotItems.Count).Name
                End If
            End With
        Next pt
    Next ws
    Application.ScreenUpdating = True
    
End Sub
Private Function pfExists(strName As String, pf As PivotField) As Boolean
    'Checks if a specified item exists within a PivotField
    Dim strTemp As String
    On Error Resume Next
    strTemp = pf.PivotItems(strName)
    On Error GoTo 0
    pfExists = (strTemp <> "")
End Function

Display More

For workbook layout, you've got 3 sheets, each with at least one PT. All of the PivotTables contain a Date type field, which has been grouped by Months and Years. The Years field is set as a Report field in each PT.

Edit: Cross-posted here: https://www.reddit.com/r/excel…manipulating_pivottables/

**Luke M** · Apr 5th 2017

Re: Converting a table to specific format

Thanks, that looks much nicer!

Is using Transpose twice like that just a way of reading in a range of cells into a one dimension array?

**Luke M** · Apr 4th 2017

Hi all,

I wrote this to convert a selected range of cells into a string that I can paste into Reddit. Reddit tables need a format like

Header1 | Header2 | Header3
---|---|---
Value | Value | (empty)
Value | Value | Value

etc.

where pipe symbol separate columns, and you use the 3 dashes to separate header row from body of table. This works, but seems like I've got some extra loops.

Code

Sub RedditTable()
    'Translates a range selection into Reddit format
    Dim rngSource As Range
    
    Dim rowCount As Long
    Dim colCount As Long
    Dim r As Long
    Dim c As Long
    Dim strDone As String
    Dim celVal As String
    
    Set rngSource = Selection
    rowCount = rngSource.Rows.Count
    colCount = rngSource.Columns.Count
    
    
    For r = 1 To rowCount
        For c = 1 To colCount
            celVal = CStr(rngSource.Cells(r, c).Text)
            If celVal = "" Then celVal = " "
            strDone = strDone & rngSource.Cells(r, c).Text & "|"
        Next c
        'Trim extra marker
        strDone = Left(strDone, Len(strDone) - 1) & Chr(10)
        
        'Put header markers
        If r = 1 Then
            For c = 1 To colCount
                strDone = strDone & "---" & "|"
            Next c
            'Trim extra marker
            strDone = Left(strDone, Len(strDone) - 1) & Chr(10)
        End If
    Next r
          
    CopyText (strDone)
    
End Sub




Sub CopyText(Text As String)
    'VBA Macro using late binding to copy text to clipboard.
    'By Justin Kay, 8/15/2014
    Dim MSForms_DataObject As Object
    Set MSForms_DataObject = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    MSForms_DataObject.SetText Text
    MSForms_DataObject.PutInClipboard
    Set MSForms_DataObject = Nothing
End Sub

Display More

**Luke M** · Mar 31st 2017

Re: Copy a varying range

Something like

Code

Cells(Start_Row, 2).Resize(Length_Row).Copy
Worksheets("Temp123").Range("C6").PasteSpecial xlPasteValues
Application.CutCopyMode = False

**Luke M** · Mar 15th 2017

Re: iserror and isblank formula use both in one formula

Try this:

=IFERROR(IF(VLOOKUP(A2,Sheet2!A2:C50,2)="", "", VLOOKUP(A2,Sheet2!A2:C50,2)), "")

**Luke M** · Mar 15th 2017

Re: left function compile error

The fact that VBE didn't autocapitalize makes me wonder if you have a function/variable called "left", and it's getting confused?

The only other thing that I see happen with causing Left/Right to fail is if you have a bad reference (usually when you've built on say Excel 2013, and then file gets opened in older version like Excel 2010).

**Luke M** · Mar 14th 2017

Re: Deleting multiple rows at once

Try this

Code

Range("A" & x).Resize(100).EntireRow.Delete

Resize method lets you state number of rows and/or column to resize to, using original cell(s) are starting point.

**Luke M** · Mar 14th 2017

Re: Compiled Error - Expected: Name parameter

Hello, and welcome to the forum!

Your line break is in wrong spot, can't end a line with comma and go to next line with using the " _" linking. Change to:

Code

ActiveWorkbook.SaveAs Filename:="C:\wamp\htdocs\sample_dos.csv", _
    FileFormat:=xlCSVMSDOS, CreateBackup:=False

**Luke M** · Mar 14th 2017

Re: Deleting multiple rows at once

Glad you figured it out. See the 2nd block of code above for how to delete multiple rows. Or, if you truly want to "select some cells and delete them"...

Code

Selection.EntireRow.Delete

**Luke M** · Mar 13th 2017

Re: Deleting multiple rows at once

When deleting, you'll want to count backwards, since the rows keep shifting. This is assuming you're doing something other than a delete, you would do

Code

For y = 1000 To 1 Step -1
'Do other stuff
Rows(y).Delete
Next y

If you truly just need to delete a block of rows

Code

Range("1:1000").EntireRow.Delete

**Luke M** · Mar 13th 2017

Re: Split worksheet into multiple worksheets with a two row header

Changed a few things during the setup. This seems to work correctly.

Code

Sub parse_data()
     
    'Splits data In Sheet1, column A into individual worksheets
     
    Dim lr As Long
    Dim ws As Worksheet
    Dim vCol, i As Integer
    Dim iCol As Long
    Dim myArr As Variant
    Dim title As String
    Dim titleRow As Integer
    vCol = 1
    Set ws = Sheets("Sheet1")
    Application.ScreenUpdating = False
    
    lr = ws.Cells(ws.Rows.Count, vCol).End(xlUp).Row
    title = "A2:C2"
    titleRow = 1
    iCol = ws.Columns.Count
    ws.Cells(1, iCol) = "Unique"
    For i = 3 To lr
        On Error Resume Next
        If ws.Cells(i, vCol) <> "" And Application.WorksheetFunction.Match(ws.Cells(i, vCol), ws.Columns(iCol), 0) = 0 Then
            ws.Cells(ws.Rows.Count, iCol).End(xlUp).Offset(1) = ws.Cells(i, vCol)
        End If
    Next
    myArr = Application.WorksheetFunction.Transpose(ws.Columns(iCol).SpecialCells(xlCellTypeConstants))
    ws.Columns(iCol).Clear
    For i = 2 To UBound(myArr)
        ws.Range(title).AutoFilter field:=vCol, Criteria1:=myArr(i) & ""
        If Not Evaluate("=ISREF('" & myArr(i) & "'!A1)") Then
            Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = myArr(i) & ""
        Else
            Sheets(myArr(i) & "").Move after:=Worksheets(Worksheets.Count)
        End If
        ws.Range("A" & titleRow & ":A" & lr).EntireRow.Copy Sheets(myArr(i) & "").Range("A1")
        Sheets(myArr(i) & "").Columns.AutoFit
    Next
    ws.AutoFilterMode = False
    ws.Activate
    Application.ScreenUpdating = True
End Sub

Display More

**Luke M** · Feb 23rd 2017

Re: VBA Preventing pasting from another sheet in same workbook

Hi DezB,

Ouch! Just kidding, I know it can be finicky. I think problem is that when you click the Reputation button, need to make sure you select the 'I approve' and not the 'I disapprove'. If you want, you could try again on this post...hopefully balance things out. =P

Either way, have a good day, and keep on learning!

**Luke M** · Feb 22nd 2017

Re: combine several books in one

Hi mavgir, and welcome to the forum!

Check out the Merge codes here: http://www.rondebruin.nl/win/section3.htm

Ron has written several great examples for many different cases.

**Luke M** · Feb 22nd 2017

Re: VBA Preventing pasting from another sheet in same workbook

The activation macro always fires, and it makes a change to the sheet. As soon as you edit something, the clipboard gets cleared, so there's nothing for you to paste.

Since the range being changes is constant, why do you need this macro? Looks like you should be able to just manually setup the formulas and forget about them.

**Luke M** · Feb 20th 2017

Re: Worksheet_Change Event Add unique value to Sheets

Does it dynamically grow as we add values to it? I.e., if it refers to 4 cells currently and we need to add a 5th value, what should happen?

**Luke M** · Feb 20th 2017

Re: Run time error 1004 application-defined or object-defined error

First off, do you really want to apply this formula to entire column? That will be over a million calculations. Ultimately, that's also what's causing this to fail. A1 (the first cell in your range) will refer to row 10 cells with a relative reference, A2 refers to 11, and so on. When you get to end of column, the references go beyond the edge of the sheet, and you get an error.

Side note, since you're really checking about which to use in VLOOKUP, you can simplify to something like:

Code

Sheets("QA").Range("A10:A20").Formula "=VLOOKUP(IF(LEFT(U10,4)=""auto"",AE10&AF10,AE10&AF10&AG10&AH10),IF(SUM(W10:AD10)>0,$AV$10:$AW$54,$AO$10:$AP$54),2,0)"