Quantcast
Channel: Excel Help Forum - Excel Programming / VBA / Macros
Viewing all 50117 articles
Browse latest View live
↧

Copying Selected Row & Formulas and inserting new row below with formulas only

August 14, 2017, 12:00 pm
$
0
0
Hello All,

My goal that I am trying to achieve is to have a user be able to select a row that contains data within a workseet- hit a macro, and a row will be inserted below the selection. Within this insert I wish the formulas that are contained within the selected row are copied into the new row, but no values. So users are able to manually enter values throughout the protected worksheet, but those values should not be copied line to line.

So I attempted this with the following VBA- but the problem I am having is, if I hide any rows throughout the worksheet, it seems to completely bug out / delete rows, and does not work properly- and I am not sure why. If I modify the filter through the drop down, it also seems to make the macro act funny. It only seems to work 'somewhat' correctly if I never change the filters/or hide any rows (out of 1000)

Any help would be appreciated!
Mike

Sub CopyAndInsertRow()
ActiveSheet.Unprotect
Dim rw As Long
With Selection
rw = .Row
.EntireRow.Copy
.Insert Shift:=xlDown
On Error Resume Next
Cells(rw + 1, 1).EntireRow.SpecialCells(xlCellTypeConstants).ClearContents
On Error GoTo 0
Application.CutCopyMode = False
ActiveSheet.Protect , AllowFiltering:=True, AllowFormattingColumns:=True, AllowFormattingRows:=True
End With
End Sub
↧
Search

Set range object to variable range

August 14, 2017, 12:17 pm
$
0
0
I've set two range objects to a range based on variable row and column variables like this:

Code:
Set CellRead = Sheets("Sheet1").Cells(RowCntRead, ColCntRead)
Set CellWrite = Sheets("Sheet2").Cells(RowCntWrite, ColCntWrite)
When the RowCntRead/Write and ColCntRead/Write variables change within a sub, will my range objects (CellRead and CellWrite) update or do I have to re-set them in some way?

If so, is there a better way to do this to avoid having to set the range object whenever the column and row variables change?
↧
↧

[SOLVED] Revise VBA to Parse Out Text for entire sheet

August 14, 2017, 12:50 pm
$
0
0
I have a VBA code that will parse out values in a text field in excel that starts with CS or cs followed by 8 digits and add those values in the same row in the empty columns to the right. What I want is for this macro to apply for the entire active sheet, search Column D for values that start with CS or cs followed by 8 digits and parse them out in the same row to the right starting at Column S going right as needed (there could up to 10 CS######## numbers in a single text cell that would need to be parsed out 10 columns to the right from Column S to Column AB)

Thank you my crazy smart Forum members for you expertise!

Here is the code that will parse out for a single active cell:

Sub GetEventIndicators()

Dim rExp As Object, allMatches As Object, match As Object
Dim specialReqs As String, eventIndicator As String
Dim row As Integer, col As Integer

specialReqs = ActiveCell.Value
row = ActiveCell.row
col = ActiveCell.Column

Set rExp = CreateObject("vbscript.regexp")
With rExp
.Global = True
.MultiLine = False
.Pattern = "[cC][sS]\d{8}"
End With

Set allMatches = rExp.Execute(specialReqs)

For Each match In allMatches
eventIndicator = match.Value
'Debug.Print "Event Indicator: " & eventIndicator
col = col + 1
Cells(row, col).Value = UCase(eventIndicator)
Next

End Sub
↧

Command buttons to change Values in Charts

August 14, 2017, 12:59 pm
$
0
0
Hi,

I would like to know how I could use an active x command button to change the values in a chart (Bar chart, doughnut charts, line graphs etc.)

What I wish to do is that if a user presses Command Button 'A' then the values in charts change according to Table 'A' and when they press Command Button 'B' then the values in charts change according to Table 'B'.
↧

Call Function Not Working

August 14, 2017, 1:00 pm
$
0
0
No idea why my call function isn't working.

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    If Worksheets("MAIN").Range("$C$11") <> "" Then
      If Worksheets("MAIN").Range("C11") = "S-0C" Or Worksheets("MAIN").Range("C11") = "S-02" Or Worksheets("MAIN").Range("C11") = "S-03" Or Worksheets("MAIN").Range("C11") = "S-53" Then

                     
            With Worksheets("MAIN").Range("C26:C50").Validation
                .Delete
                .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
                    Operator:=xlBetween, Formula1:="=scope1"  'Formula1:=Worksheets("Scope Options").Range("$C$12:$C$28")
            End With

   
      ElseIf Worksheets("MAIN").Range("C11") = "S-F4" Or Worksheets("MAIN").Range("C11") = "S-F5" Or Worksheets("MAIN").Range("C11") = "S-0E" Or Worksheets("MAIN").Range("C11") = "S-56"  Then

           
                       
            With Worksheets("MAIN").Range("C26:C50").Validation
                .Delete
                .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
                    Operator:=xlBetween, Formula1:="=scope2" 
            End With
     
        ElseIf Worksheets("MAIN").Range("C11") = "S-0G" Then

       
           
            With Worksheets("MAIN").Range("C26:C50").Validation
                .Delete
                .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
                    Operator:=xlBetween, Formula1:="=scope3"
            End With
    End If

    End If
End If

    If Target.Address = "$C$26" And Target.Value = "Test1" Or Target.Value = "Test2" Or Target.Value = "Test3" Then
        Range("$C$27").Value = "Programs"
    End If
   

PopPartsOpt
   
End Sub

Here is the routine I'm trying to call.

Code:
Private Sub PopPartsOpt()

Dim wsMain, wsPartsOp, wsOutOpt As Worksheet
    Set wsMain = Sheets("Main")
    Set wsPartsOp = Sheets("Parts - Optional")
    Set wsOutOpt = Sheets("Outage Options")
    If Worksheets("MAIN").Range("$C$11") <> "" Then
       
        If Worksheets("MAIN").Range("C11") = "S-0C" Or Worksheets("MAIN").Range("C11") = "S-02" Or Worksheets("MAIN").Range("C11") = "S-03" Or Worksheets("MAIN").Range("C11") = "S-53" And Worksheets("MAIN").Range("C26") = "Test1" Then
       
'            Worksheets("Parts - Optional").Range("C15").Selection
            wsOutOpt.Range("Comb1").Copy wsPartsOp.Range("C15")
            NextRow = Worksheets("Parts - Optional").Range("C14").End(xlDown).Row + 1
            Else
                wsPartsOp.Range("C15").Value = ""
        End If
       
        If Worksheets("MAIN").Range("C11") = "S-0C" Or Worksheets("MAIN").Range("C11") = "S-02" Or Worksheets("MAIN").Range("C11") = "S-03" Or Worksheets("MAIN").Range("C11") = "S-53" And Worksheets("MAIN").Range("C26") = "Test2" Then
            wsOutOpt.Range("CombI2").Copy wsPartsOp.Range("C15")
            NextRow = Worksheets("Parts - Optional").Range("C14").End(xlDown).Row + 1
        End If

        If Worksheets("MAIN").Range("C11") = "S-0C" Or Worksheets("MAIN").Range("C11") = "S-02" Or Worksheets("MAIN").Range("C11") = "S-03" Or Worksheets("MAIN").Range("C11") = "S-53" And Worksheets("MAIN").Range("C26") = "Test3" Then
            wsOutOpt.Range("Major1").Copy wsPartsOp.Range("C15")
            NextRow = Worksheets("Parts - Optional").Range("C14").End(xlDown).Row + 1
        End If
       
       
       
    End If


End Sub
↧
↧

vba to apply formula at last 3 rows of data

August 14, 2017, 1:32 pm
$
0
0
Hi all,

i need vba to apply three different formula to be applied at last 3 rows.

But challenge is the data range might vary for different workbooks, i need to run vba so it will apply all three different formulas based on the available data.

Formulas which i use is count if and Sum.

Attached sample workbook.

Can somebody help me please.
↧

Need a set of eyes to find what I can't

August 14, 2017, 1:44 pm
$
0
0
I would really appreciate someone taking a look at this code. I wrote it to go through a bill of materials and match a regular expression pattern to identify certain items and generate a cut list. I'm not really getting any compile errors, but it's also not doing anything at all when it's run. This code is all placed within a module:

Code:
Option Explicit

Dim Pattern(1 To 12) As String            'Array of patterns

Dim CellRead As Range
Dim CellWrite As Range

Dim RowCntRead As Integer
Dim RowCntWrite As Integer
Dim ColCntRead As Integer
Dim ColCntWrite As Integer

Sub InitializeArray()

Pattern(1) = "-*"
Pattern(2) = "TS\d*|HSS\d*"
Pattern(3) = "L\d*"
Pattern(4) = "C\d*"
Pattern(5) = "MC\d*"
Pattern(6) = "W\d*"
Pattern(7) = "\d+W\d|GRATE|GRATING"
Pattern(8) = "D\d*"
Pattern(9) = "CF\d*"
Pattern(10) = "FB\d*"
Pattern(11) = "EXP\d*"

End Sub

Function IndexNumber(ByVal InputString As String)

Dim i As Integer            'Pattern index

For i = 1 To UBound(Pattern)
    With CreateObject("VBScript.RegExp")
        .Global = False
        .IgnoreCase = True
        .Pattern = Pattern(i)
       
        If .Test(InputString) Then
            IndexNumber = i
            Exit Function
           
        End If
    End With
Next i
   
IndexNumber = 0
End Function

Function SplitString(ByRef InputString As String, ByVal i As Integer, ByVal Element As Integer)

Dim SplitArray() As String      'Array of substrings

With CreateObject("VBScript.RegExp")
        .Global = False
        .IgnoreCase = True
        .Pattern = Pattern(i)
       
    If .Test(InputString) Then
        InputString = .Replace(InputString, "|")
        SplitArray = Split(InputString, "|")
        SplitString = SplitArray(Element)
        Exit Function
    End If
   
End With

SplitString = "--"

End Function

Private Sub NextCellWrite()

ColCntWrite = ColCntWrite + 1
Set CellWrite = Sheets("CUT LIST").Cells(RowCntWrite, ColCntWrite)

End Sub

Sub SetCellRead()

Set CellRead = Sheets("BOM").Cells(RowCntRead, ColCntRead)

End Sub

Sub SetCellWrite()

Set CellWrite = Sheets("CUT LIST").Cells(RowCntWrite, ColCntWrite)

End Sub

Private Sub PopulateCutList_Click()

InitializeArray

Dim PatternNo As Integer                'Pattern identification number
Dim i As Integer                        'Pattern parse count
Dim CellReadTimeout As Integer

Dim DetailNo As Variant
Dim MaterialType As String
Dim MaterialSpec As String
Dim JobQty As Integer
Dim CutLength As String
Dim CutCode As String

'  ***Initialize***

RowCntRead = 2
RowCntWrite = 4
ColCntRead = 3
ColCntWrite = 1

CellReadTimeout = 0

Set CellRead = Sheets("BOM").Cells(RowCntRead, ColCntRead)
Set CellWrite = Sheets("CUT LIST").Cells(RowCntWrite, ColCntWrite)

'------------------------------------------------------------------

For i = 2 To UBound(Pattern)

    Do While CellReadTimeout < 5

        PatternNo = IndexNumber(CellRead.Value)
   
   
        If CellRead.Value <> "" Then
   
            If PatternNo = i Then

                Select Case PatternNo
   
                    Case 2
                        MaterialType = "TUBE STEEL (TS)"
           
                    Case 3
                        MaterialType = "ANGLE (L)"
           
                    Case 4
                        MaterialType = "C-CHANNEL (C)"
           
                    Case 5
                        MaterialType = "MC CHANNEL (MC)"
                                               
                    Case 6
                        MaterialType = "WIDE FLANGE BEAM (W)"
                   
                    Case 7
                        MaterialType = "STEEL BAR GRATING, WELDED"
                       
                    Case 8
                        MaterialType = "ROUND TUBE"
                       
                    Case 9
                        MaterialType = "ROUND BAR"
                       
                    Case 10
                        MaterialType = "FLAT BAR"
                       
                    Case 11
                        MaterialType = "EXPANDED METAL"
           
                End Select
   
                ColCntRead = 4
                SetCellRead
                DetailNo = Trim(SplitString(CellRead.Value, 4, 0))
                CutCode = Trim(SplitString(CellRead.Value, 4, 1))
               
                ColCntRead = 6
                SetCellRead
                JobQty = CellRead.Value
               
                ColCntRead = 8
                SetCellRead
                CutLength = CellRead.Value
               
                ColCntRead = 3
                SetCellRead
                MaterialSpec = CellRead.Value
   

                CellWrite.Value = DetailNo
                NextCellWrite
                CellWrite.Value = MaterialType
                NextCellWrite
                CellWrite.Value = MaterialSpec
                NextCellWrite
                CellWrite.Value = JobQty
                NextCellWrite
                CellWrite.Value = CutLength
                NextCellWrite
                CellWrite.Value = CutCode
       
                RowCntWrite = RowCntWrite + 1
                ColCntWrite = 1

                CellReadTimeout = 0
       
            End If
   
            RowCntRead = RowCntRead + 1
            SetCellRead
   
        Else:

            RowCntRead = RowCntRead + 1
            SetCellRead
           
            CellReadTimeout = CellReadTimeout + 1
           
        End If
   
    Loop
   
RowCntRead = 2
SetCellRead
RowCntWrite = RowCntWrite + 2
SetCellWrite

Next i

End Sub

Private Sub ClearBOM_Click()

ThisWorkbook.Worksheets("BOM").Range("A1:J500").ClearContents

End Sub

Private Sub ClearCutList_Click()

ThisWorkbook.Worksheets("CUT LIST").Range("A3:F500").ClearContents

End Sub
↧

[SOLVED] Format date to MM-DD-YYYY

August 14, 2017, 2:38 pm
$
0
0
Hi!

Kutools trial has ended and I cannot for the life of me figure out how to change the date format YYYY-MM-DD to MM-DD-YYYY.
When I tried to create a Custom date it just give me ########

For example I need 20170815 to change to 08-15-2017

I'd attached a sample sheet but for some reason the attachment tool isn't working so here's a photo. Hope that shows.

EXCEL Capture.JPG



Thank you!
↧
Search

Sum in Used Rage

August 14, 2017, 3:27 pm
$
0
0
Id like to a sum formula in the used range of this workbook if at all possible.

Sum.PNG
↧
↧

Consolidating sequence to update existing rows otherwise add row

August 15, 2017, 8:02 am
$
0
0
Hello!

i'm kinda new to VBA, so i kinda your help would be appreciated.

I have ~300 files with data and a masterfile, which opens every file, copies data to masterfile by adding a new row. The question - i want vba to:

Open each of 300 files
Check whether i.e. SAP number in opened file AND master file exist and match. If yes then update the existing row with same SAP number from opened file, otherwise add a new row.
So basically i'm stuck trying to figure out how can vba detect the necessary row to update. Any help will be appreciated.

I have the following code:

Code:
Sub CommandButton1_Click()

Dim c As Long
[i1] = 0
If Dir("C:\Users\SESA\Desktop\Reports\My project\pmf macros\test modify\*.*") = "" Then Exit Sub Else c = 1
Do
If Dir = "" Then Exit Do Else c = c + 1
Loop Until False
[i1] = c

Dim lr As Long
Dim lAllCnt As Long
lAllCnt = [i1]
Call Show_PrBar_Or_No(lAllCnt, "Initializing...")

Dim sFolder As String
Dim sFile As String
Dim wbD As Workbook, wbS As Workbook

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set wbS = thisWorkbook
sFolder = wbS.Path & "\"

sFile = Dir(sFolder)
lr = 0
Do While sFile <> ""
    lr = lr + 1
    If bShowBar Then Call MyProgresBar

    If sFile <> wbS.Name Then
        Set wbD = Workbooks.Open(sFolder & sFile) 'open the file; add condition to
        wbD.Sheets("PMF").Range("A2:MP2").Copy
        wbS.Activate
            Range("B" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormats
            Range("B" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValuesAndNumberFormats
            Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Select
        Else

        ActiveCell.FormulaR1C1 = "=HYPERLINK(RC[1],RC[2]&""-""&RC[3])"
        Application.CutCopyMode = False
        wbD.Close savechanges:=True 'close without saving
    End If

    sFile = Dir 'next file
Loop


    If bShowBar Then Unload frmStatusBar

Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
To be not misunderstood the code contains POC bar.
↧

Spreadsheet Using SQL Tables and Lookups

August 15, 2017, 8:24 am
$
0
0
Hello -

I have a SQL table that I've pulled onto Sheet1. I have another worksheet (Sheet2) that has a data entry field for a sales order number. When this sales order number is entered, I want Excel to find the sales order on the SQL table and pull every part in Column D onto Sheet2 for this sales order, provided Column C of Sheet1 has a 1 or a 7 in it.

I am also going to be pulling the country onto Sheet2. I'd like to be able to have additional worksheets display (or hide certain worksheets) based on the country that is on Sheet2.

Is this possible?

Thank you for your help.
↧

vba to wrap formula with autofill not working

August 15, 2017, 8:25 am
$
0
0
Trying to split data in their respective columns C and D with vba still to last data row on column A.

Row 1 are headers

The first method and second methods to wrap the formula in vba but unsuccessful

Any assistance please

Method 1

Code:
Sub FillDown()

      Dim strFormulas(1 To 2) As Variant

       
    LastRow = .Range("A" & .Rows.Count).End(xlUp).Row

    With Worksheets("calibration")

        strFormulas(1) ="--SUBSTITUTE(LEFT(c2,FIND(".",c2)-1)," ","")"

        strFormulas(2) ="=TRIM(MID(d2,-LOOKUP(1,-MIN(SEARCH({"EA","PKS"},d2&"EAPKS"))),3))"
     

        Range("c2:c2").Formula = strFormulas(1)

        Range("c2").AutoFill Destination:=Range("c2:c2" & lastRow)

        Range("d2:d2").Formula = strFormulas(2)
               
                Range("D2").AutoFill Destination:=Range("D2:D2" & lastRow)
                 
       
    End With

End Sub



Method 2
Code:
Sub autofillshop()



With Sheets("calibration")
Lastrow = Range("A" & Rows.Count).End(xlUp).Row

Range("c2").Formula = ="--SUBSTITUTE(LEFT(c2,FIND(".",c2)-1)," ","")"
Range("c2").AutoFill Destination:=Range("c2:c2" & Lastrow)

Range("d2").Formula = ="--SUBSTITUTE(LEFT(d2,FIND(".",d2)-1)," ","")"
Range("d2").AutoFill Destination:=Range("d2:d2" & Lastrow)

End With

End Sub
Attached Files
↧

Autocomplete from list

August 15, 2017, 8:29 am
↧
↧

Single Sided printing

August 15, 2017, 8:46 am
$
0
0
Hi I have a Workbook with 3 sheets that I want want to print single sided from a command button. Does anyone know what the VBA is to ensure that they are printed single sided?
↧

YES NO Button

August 15, 2017, 8:54 am
$
0
0
Hi

I am having some trouble adding a Yes/No option to some code.

The logic I would like to happen is as follows

Press Button
Pop Up Message appears saying "Are you sure you want to Archive"
If yes RUN:

Code:
Sub CutCopy()
Worksheets("Demand Capture").Unprotect
Worksheets("Archive").Unprotect
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim lastrow As Long, i As Long, j As Long
Set ws1 = Sheets("Demand Capture")
Set ws2 = Sheets("Archive")
lastrow = ws1.Cells(Rows.Count, 1).End(xlUp).Row
For i = 4 To lastrow
    If ws1.Cells(i, 1).Value = "Y" Or ws1.Cells(i, 24).Value = "Rejected" Then
        ws1.Rows(i).Copy
        j = 2
        Do Until IsEmpty(ws2.Cells(j, 1))
            j = j + 1
        Loop
        ws2.Cells(j, 1).PasteSpecial (xlPasteAll)
        ws1.Rows(i).EntireRow.Delete
        i = i - 1
        lastrow = lastrow - 1
    End If
    Next i
    Worksheets("Demand Capture").Protect
    Worksheets("Archive").Protect
    Worksheets("Archive").Activate
End Sub
If no, Close and carry out no action.

Any thoughts would be greatly appreciated.

Thanks

JDOPAL
↧
Search

[SOLVED] Populate strip_deck worksheet using different columns.

August 15, 2017, 8:58 am
$
0
0
I have attached an Excel macro workbook and need to populate the worksheet "strip_deck" as follows:

Populate GAS (column C in "strip_deck") using column H from "natural_gas".
Populate OIL (column D in "strip_deck") using column H from "crude_oil".

I did not write the macro so would appreciate any help.

Thank you.
Attached Files
↧

Find and Complete on worksheet via Userform VBA

August 15, 2017, 9:03 am
$
0
0
Hi,

I have created a userform to add in the current weeks exchange rate.
I now cannot get the code to work once clicked OK to find the week number in a list on a worksheet "Fx" and add the values from the userform to the page.
I have attached pictures of the userform and the worksheet I am trying to add into - hopefully it makes more sense to what code I am needing.
I am very new to VBA and do not fully understand so any help would be greatly appreciated.

Userform.PNG
Worksheet.PNG
↧
↧

VBA: Delete cell contents if other cell=1

August 15, 2017, 9:04 am
$
0
0
Good afternoon,

I'm very much new to vba, even though I have some knowledge of excel.

What I'm looking for is some code that evaluates cells AP9,11,13,15,17,19 and if they have a value of 1 (derived from a formula), to clear the contents of the corresponding cells in O9,11,13,15,17,19. This needs to be applied to an entire workbook with multiple sheets.

I'm looking to learn more about vba, but I'm completely stuck on this at the moment, so any help would be much appreciated.

Cheers all,

George
↧

New to VBA looking for help for basic Look-up and cell position code

August 15, 2017, 9:08 am
$
0
0
I have used this forum many time for help with formulas and was able to find the solutions from past questions...
First time posting being I am venturing into the world of VBA out of necessity.

Any help you can provide will be appreciated. To be honest this is my first need for VBA and I dont know where to start writing the code...

• One will scan a barcode into cell M1
The scanner is set to press enter after the scan
• Need to lookup the value in M1 to the information in column J
There might be more /less rows in J depending on the build sheet.
To keep this like of code working for all, it needs to look at all of J
• Once the number is located in J the corresponding cell to the left “I” needs to be highlighted
• The user will now scan the Workorder/Batch/SN in the highlighted cell
The scanner is set to press enter after the scan
• Once this number is scanned I would like to delete the information in M1 and have it active for the next scan.


Can you please help me with the code for this scenario?
Attached Images
↧

Combining worhseet functions rounddown & average if

August 15, 2017, 9:49 am
$
0
0
I can't get the below to work, can someone advise how the syntax should be for this formula please?

Code:
Application.WorksheetFunction.RoundDown.AverageIf(Range("M2:M" & RRows), ">0", 3)
↧
Viewing all 50117 articles
Browse latest View live
Search