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

[SOLVED] Add More Sheets

February 26, 2020, 6:15 am
$
0
0
Good day,

I have this Recipe Book that has code to generate sheets based on the 'Template' sheet which is normally hidden. On each sheet there are green and red shapes to unprotect or protect all sheets if needed.

On the 'Recipe Contents' sheet there is a green shape to Create Recipe Sheets which copies the 'Template' sheet and numbers the new sheets R-1, R-2, etc. for the number of sheets requested.

My question can the Create code be altered if the user wants to add more sheets to the 'R' series ? In this case additional sheets would start at R-3 since there are R-1 and R-2 in place.

Thank you very much for your help
RChad
Attached Files
↧
Search

Drop downlist Help - set default..

February 26, 2020, 6:38 am
$
0
0
Hi All,

Not sure if this is in the correct area on here.

Is there a way to set a default in a drop down list.

Basically, in the current work book the main page has buttons to take you to different sheets within the workbook. What I need is, when button one is clicked it takes you to a 'booking' worksheet. On the 'booking' worksheet the customer has to select their customer number from a drop down list. What I need to do it set a default on the drop down list when the customer leaves the booking worksheet by clicking a button to go back to the main page..

Thanks
↧
↧

How to update file without clicking the EDit Links Update Values

February 26, 2020, 7:48 am
$
0
0
Hi Guys

I want to create a button so that when i click that button it update my file which is connected to other file.

Thanks
↧

Aggregate data of multiple sheets

February 26, 2020, 7:55 am
$
0
0
Hello!

I have an Excel document with one "Summary" sheet and 1..n more sheets named "January 2020", "February 2020" and so on.
An example of my Excel file is attached.

In the monthly sheets I have an ID, a name, an email address and a double value per row, for example:
6u8P John MAILADDRESS 12.0

The ID is unique and should be of course the identifier. There is only 0 or 1 entry per ID per sheet available.
What I try to achieve ist, that on my "Summary" sheet I have all IDs from all other sheets listed, but only once. So if in one sheet ID 6u8P is listed it should be always listed in the sheet "Summary". So the order of the IDs and the amount of IDs is not always the same from sheet to sheet.

The name "John" should be in the Summary sheet be listed with his ID 6u8P, but then the name should be the name which is used in the last sheet of all, because the name is editable, and so the last name of the latest sheet should be used. The same for the email address. The email address of the last sheet should be shown in the Summary sheet.

And last but not least, the values of the IDs in the last column, in this example 12.0 should be summed up of all sheets and displayed in the Summary sheet.

So I tried to use VBA and this is the result so far:
Code:
Function SumIfTab2_to_n(SearchTerm As String, SearchColumn As Variant, ResultColumn As Variant) As Double
Dim i As Integer
Dim Cell As Range
Dim LastRow As Integer
For i = 2 To Sheets.Count
    LastRow = Sheets(i).Cells(Rows.Count, SearchColumn).End(xlUp).Row
    For Each Cell In Sheets(i).Range(Cells(1, SearchColumn).Address & ":" & Cells(LastRow, SearchColumn).Address)
        If Cell.Value = SearchTerm Then
            SumIfTab2_to_n = SumIfTab2_to_n + Sheets(i).Cells(Cell.Row, ResultColumn).Value
        End If
    Next Cell
Next i
End Function
So I am able to use =SumIfTab2_to_n("6u8P";"A";"D") within a cell and I will get the sum of the user with the ID 6u8P correctly iterated over the sheets. But I do not want to have as a parameter the ID, because then I need to aggregate all the user IDs for my own. It should be in my summary automatically create this kind of view:
6u8P Johnny MAILADDRESS 14
3DgT Simon MAILADDRESS 20.5
jU7Z Jimmy MAILADDRESS 36
Nms6 Jane MAILADDRESS 88
So I have no idea how to generate this list of IDs at the moment and to achieve what I tried to explain above. So hopefully you have any ideas?

Best Regards PHANTOMIAS
Attached Files
↧

[SOLVED] List controls on a userform

February 26, 2020, 8:05 am
$
0
0
Hello everybody

I need help please

I am trying to list the controls from each Userfrom, listed in the combobox, this works 100% in the same workbook. As soon I use it as an addin and it loads the active workbook's userforms, I get an Run-time error 424 object required error
↧
↧

Reference Column by specific Text in the Header row

February 26, 2020, 9:28 am
$
0
0
Currently Running the below code, and need to make an edit to one part.

Code:
Sub VlookMultipleWorkbooks()

    Dim lookFor As Range
    Dim looktran As Range
    Dim shipdate As Long
    Dim srchRange As Range
    Dim srchtran As Range
    Dim lrow As Long
    Dim lcol As Long
    Dim dccol As Long
    Dim sccol As Long
    Dim transcol As Long
    Dim shipcol As Long
    Dim rowstart As Integer

    Dim book1 As Workbook
    Dim book2 As Workbook

    Dim book2Name As String
    book2Name = "DC_Data.xlsx"    'modify it as per your requirement

    Dim book2NamePath As String
    book2NamePath = "C:\Users\markf\OneDrive\" & book2Name

    Set book1 = ThisWorkbook
   
    If IsOpen(book2Name) = False Then Workbooks.Open (book2NamePath)
    Set book2 = Workbooks(book2Name)
   
    lcol = Cells(1, Columns.Count).End(xlToLeft).Column
        dccol = lcol + 1
        sccol = lcol + 2
        transcol = lcol + 3
        shipcol = lcol + 4
   
    lrow = Cells(Rows.Count, 1).End(xlUp).Row
   
        Cells(1, dccol).Value = "DC"
        Cells(1, sccol).Value = "SCAC"
        Cells(1, transcol).Value = "Transit Days"
        Cells(1, shipcol).Value = "Ship Date"
       

    rowstart = 2

   
    Do While rowstart <= lrow
   
        Set lookFor = book1.Sheets(1).Cells(rowstart, 3)
        Set srchRange = book2.Sheets(1).Range("A:B")
   
            Cells(rowstart, dccol).Value = Application.VLookup(lookFor, srchRange, 2, False)
       
       
       
        Set looktran = book1.Sheets(1).Cells(rowstart, dccol)
        Set srchtran = book2.Sheets(2).Range("A:C")
       
            Cells(rowstart, sccol).Value = Application.VLookup(looktran, srchtran, 2, False)
            Cells(rowstart, transcol).Value = Application.VLookup(looktran, srchtran, 3, False)
           
            Cells(rowstart, shipcol).Formula = "=Workday(K" & rowstart & ",-2-" & Cells(rowstart, transcol).Value & ")"
   
            rowstart = rowstart + 1

    Loop

   
   

End Sub


Column K as referenced in the below formula may really not always be column K.

What I am looking to do is replace that with a variable that would be assigned a column based on specific text (say Stock) that would be in the header row of the data.
Code:
Cells(rowstart, shipcol).Formula = "=Workday(K" & rowstart & ",-2-" & Cells(rowstart, transcol).Value & ")"
How do I go about doing something like this?
↧

Sorting Words and Numbers in excel vba

February 26, 2020, 9:44 am
$
0
0
I'm looking to use a macro to calculate data in a chart and then sort it. The sort code I currently have works well, however, I want it to sort the words after the numbers. Currently it is the other way around. My data has positive numbers, negative numbers, and words.

So the correct order should be (in descending order) positive numbers, negative numbers, then words. Is there a way to do this in vba code?

I have attached a sample document to this post. Thanks in advance!

Code:
Sub Sort()
   
With Worksheets("Sheet1").Sort
    .SortFields.Add Key:=Range("B1"), Order:=xlDescending
    .SortFields.Add Key:=Range("A1"), Order:=xlAscending
    .SetRange Range("A1:B11")
    .Header = xlYes
    .Apply
End With

End Sub
Attached Files
↧

Popup Userform for Data Entry

February 26, 2020, 9:45 am
$
0
0
Hey there, this is my first post on the forums!

I’ve been using ANALYSISTABS Advance Project Plan Portfolio Template for a couple weeks now, and I love it! I just wish the data entry was much easier for my coworkers to do. Can anyone come up with a way to have a popup userform when you click on any cell of the data table that contains text boxes and a calendars for a start date and an end date that also allows you to edit any already existing rows full of data?
↧
Search

Look Up Inquiry

February 26, 2020, 9:56 am
$
0
0
Please see attachment: This is what I'm trying to do

Input data from 2 drop down cells
Have Everything be pulled from another sheet that contains exact match data from those 2 cells

Sorry if my description is a little vague!
Attached Files
↧
↧

VBA script no longer performing SaveAs FileFormat xlUnicodeText

February 26, 2020, 10:33 am
$
0
0
Below is a VBA script that I've been using to save the different Albums in my spreadsheet into their own separate files.

This has been working fine until I upgraded to Catalina and started using Excel 16.34.

The XLSX sheets save fine, but it has stopped saving the TXT copies in UTF-16 Unicode Text format. Those files aren't created. Would anyone be able to tell me how I could correct this?

Code:
Sub parse_data()
    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 = 6 for Volume, 10 for Library
    vcol = 6
    Set ws = Sheets("Sheet1")
    lr = ws.Cells(ws.Rows.Count, vcol).End(xlUp).Row
    title = "A1:DL1"
    titlerow = ws.Range(title).Cells(1).Row
    icol = ws.Columns.Count
    ws.Cells(1, icol) = "Unique"
    For i = 2 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
   
    MyPath = ThisWorkbook.Path
    For Each sht In ThisWorkbook.Sheets
    sht.Copy
    ActiveSheet.Cells.Copy
    ActiveSheet.Cells.PasteSpecial Paste:=xlPasteValues
    ActiveSheet.Cells.PasteSpecial Paste:=xlPasteFormats
    ActiveWorkbook.SaveAs Filename:=sht.Name & ".xlsx", FileFormat:=51
    ActiveWorkbook.SaveAs Filename:=sht.Name & ".txt", FileFormat:=42
    ActiveWorkbook.Close savechanges:=False
    Next sht

End Sub
↧

Select sheets to print VBA in 3 columns

February 26, 2020, 10:36 am
$
0
0
Hi There,

I am using the following code to select the sheets I want to print and then send them to the printer.

The issues I have is that I have so many sheets 2 columns are not enough I need the layout changed to 3 columns if possible.

Here is the code I am using.

Code:
Option Explicit
Sub SelectSheets()
Application.Dialogs(xlDialogPrinterSetup).Show
Dim i As Integer
Dim TopPos As Integer
Dim SheetCount As Integer
Dim PrintDlg As DialogSheet
Dim CurrentSheet As Worksheet
Dim cb As CheckBox
Application.ScreenUpdating = False
' Check for protected workbook
If ActiveWorkbook.ProtectStructure Then
MsgBox "Workbook is protected.", vbCritical
Exit Sub
End If
' Add a temporary dialog sheet
Set CurrentSheet = ActiveSheet
Set PrintDlg = ActiveWorkbook.DialogSheets.Add
SheetCount = 0
Dim Hor As Integer 'this will be for the horizontal position of the items
Hor = 78
Dim wd As Integer 'this will be for the overall width of the dialog box
wd = 230
TopPos = 35
For i = 1 To ActiveWorkbook.Worksheets.Count
Set CurrentSheet = ActiveWorkbook.Worksheets(i)
' Skip empty sheets and hidden sheets
If Application.CountA(CurrentSheet.Cells) <> 0 And _
CurrentSheet.Visible Then
SheetCount = SheetCount + 1
If SheetCount = 30 Then
Hor = 223
wd = 380
TopPos = 35
End If
PrintDlg.CheckBoxes.Add Hor, TopPos, 145, 16.5
PrintDlg.CheckBoxes(SheetCount).Text = _
CurrentSheet.Name
TopPos = TopPos + 13
End If
Next i
' Move the OK and Cancel buttons
PrintDlg.Buttons.Left = 390
' Set dialog height, width, and caption
With PrintDlg.DialogFrame
.Height = 415
'.Height = Application.Max _
'(68, PrintDlg.DialogFrame.Top + TopPos)
.Width = wd
.Caption = "Select sheets to print"
End With
' Change tab order of OK and Cancel buttons
' so the 1st option button will have the focus
PrintDlg.Buttons("Button 2").BringToFront
PrintDlg.Buttons("Button 3").BringToFront
' Display the dialog box
CurrentSheet.Activate
Application.ScreenUpdating = True
If SheetCount <> 0 Then
If PrintDlg.Show Then
For Each cb In PrintDlg.CheckBoxes
If cb.Value = xlOn Then
Worksheets(cb.Caption).Activate
ActiveSheet.PrintOut
' ActiveSheet.PrintPreview 'for debugging
End If
Next cb
End If
Else
MsgBox "All worksheets are empty."
End If
' Delete temporary dialog sheet (without a warning)
Application.DisplayAlerts = False
PrintDlg.Delete
' Reactivate original sheet
Application.Goto Worksheets("XXXXXXX ").Range("c7"), Scroll:=False
End Sub
Any help is appreciated.
↧

Extract data based on range of dates and value

February 26, 2020, 11:03 am
$
0
0
I dates in Col B and values in Col C on sheet "Data"

I would like to extract the data in Cols A to C and paste these on sheet "extraction" based on

the values in Col C in the date range containing P2 (Start date) to P3 (end date) and all the values in the date range must equal the value in Q2

Where the values in the date range does not equal the value in Q2, then no data to be extracted


It would be appreciated if someone could kindly assist me
↧

Changing Height of Copied Picture

February 26, 2020, 11:25 am
$
0
0
Hi - I am attempting to change the height of a copied picture I have and paste in excel. Does anyone know how to do this?

This is what I have - The commented out line do not work. I am not sure how to reference the yet-to-be-pasted picture?


Code:
With Worksheets("Sheet3").Range("A2:D13")
.CopyPicture xlScreen, xlBitmap
'If .Height > 2 Then
'.Height = 2
'End If
End With

Worksheets("Sheet3").paste _
    Destination:=Worksheets("Sheet3").Range("E6")
↧
↧

Print a specific number of pages based on cell value

February 26, 2020, 11:30 am
$
0
0
Hi All,

Is there a way to print a set number of pages from a valve in a cell .. The cell value does change ..

I.E
Cell A1 value is set to 4 - I want to print 4 pages
or
Cell A1 value is set to 2 - I want to print 2 pages

And so ..

Thanks
↧

vba WorksheetFunction

February 27, 2020, 2:10 pm
$
0
0
Would someone take a look at this WorksheetFunction. Complie error: Sub or Function not defined

x = Application.WorksheetFunction.Match(EoMonth(CDate(Date), -1) + 1, Sheet27.Range("A4:A147"), 0)

Thank you.
↧
Search

Type Mismatch Error

February 27, 2020, 2:30 pm
$
0
0
Hi everyone
I have code to save user form data to a table and to also add some of the data to another table on the same sheet

The code I am using is exactly the same for both tables with the change in cell and range reference , of course.

In the first instance saving to first table, the code to insert a new table row is as follows:

Code:
[Private Sub cmdSave_Click()
'Set the variables
Dim tbl As ListObject
Dim TableNewRow As Excel.Range
Dim MaxID As Integer
Dim vCellValue As Integer

On Error GoTo 0
'Declare the name and location of the table where the data wil be saved
Set tbl = Sheets("BarInventory").ListObjects("tblBarInventory")


If tbl Is Nothing Then
MsgBox "I can't find the bar table." & vbNewLine & "It might have been renamed, moved or deleted."
    Exit Sub
End If
Range("C5").Activate 'C5 is the first cell with a record ID and is dimmed as integer
vCellValue = Range("C5").Value
Range("C5").ClearContents
Range("C5").Value = vCellValue
tbl.ListRows.Add    'Add a new row
'
'
'
''
This all works without a hitch

In the next section to save the same date to another table, I have, again in part,

Code:
Dim ctbl As ListObject
Dim CNewRow As Excel.Range
Dim cCellValue As Integer

'Declare the name and location of the table where the data wil be saved
Set ctbl = Sheets("BarInventory").ListObjects("tblBarCount")


If ctbl Is Nothing Then
MsgBox "I can't find the bar count table." & vbNewLine & "It might have been renamed, moved or deleted."
    Exit Sub
End If
Range("Q8").Activate  'This the record id number for the second table and is dimmed as integer. The corresponding column in the table is frmated as a number with no decimals
cCellValue = Range("Q8").Value 'This si where the type mismatch occurs
Range("Q8").ClearContents
Range("Q8").Value = cCellValue
ctbl.ListRows.Add    'Add a new row
The funny part is that sometime it works fine and other times (more often than not, it returns the error.

I looked at both parts of the statement in the Watch Window and it tells me that second part (=Range("Q8").value is a variant. I don't know how to fix that. Like I said, the table cells are formatted as a number without decimals.

Its obvious that I'm missing something but I don't know what it is.
↧

[SOLVED] Skipping text to column warning dialogue

February 27, 2020, 2:38 pm
$
0
0
Hi All,

I've got this code here, (which is part of a bigger macro) to convert text to columns and it works well except for the warning dialogue (There's already data here. Do you want to replace it?) which automatically pops up and I have to keep clicking yes every time I run the macro.

Is there anything i can do to disable this particular pop up? or maybe add something to the code so it clicks 'yes' automatically.
Code:
Columns("A:A").Select
          Selection.TextToColumns Destination:=Range("A1"), DataType:=xlFixedWidth, _
          FieldInfo:=Array(Array(0, 1), Array(9, 1), Array(18, 1), Array(146, 1)), _
          TrailingMinusNumbers:=True

Thank you!
↧
↧

Split a master file into separate files based on a key column

February 27, 2020, 2:40 pm
$
0
0
Hello,

I require a looping macro that will work through this data and create a separate file for each location listed in column C.
I will place the master file in the same folder every time and require the splitter to create a file for each unique location with each split file taking the name of its location.
In the enclosed example there are four locations so four output files required.

In reality I have a file of over 2,000 rows with about 40 different locations, but hopefully the example file is enough to explain my requirement.

Thanks for any help you can give.
Attached Files
↧

help in excel, detect the largest and smallest digit of pick3 zero is the smallest digit *

February 27, 2020, 3:30 pm
$
0
0
help in excel, detect the largest and smallest digit of pick3 zero is the smallest digit
* example
456
489
156
014
at 456, the double of the position is 1.3
we have three positional doubles
* 1,2,1,3, 2,3 possible to be the smallest and largest
* inside pick3, also the macro needs to make the location to be the first or second of the pair
* ex
489 = 1.3, smallest digit in the first position of the pair and largest in the 2nd position
but in this example =
971 = 1.3 the largest (9) digt is in 1st position
* need someone in excel
↧

Function to step through an array only once per call.

February 27, 2020, 3:58 pm
$
0
0
Hi all.

Not sure if this can be done or not but here goes.

I have a variable in a macro that needs to be incremented from an array inside a For/Next loop. The For/Next loop steps through 30 times, once per chart update. I also need to update a variable from an array. The array contains a set of numbers relating to rows on worksheets.

I am not sure how to go about doing this. I have the For/next loop working fine now but I can't get the variable to only update once per loop.

Here is what I have so far. I have started to put the array inside a function, may or may not be the way to go.

Code:
Function SetRowNum() As Long

    Dim arr1() As Variant
    Dim d
           
        arr1 = Array(8, 9, 11, 12, 13, 14, 15, 17, 23, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 39, 40, 41, 44, 45, 46, 47, 48, 49, 57, 58)

        For Each d In arr1
       

End Function
Here is where it is called from.

Code:
    With ActiveSheet          'Adds limit lines
        c = 65
        For b = 0 To indx
        rownum = SetRowNum

            With ActiveSheet.ChartObjects("Chart " & b + 1).Activate

                On Error Resume Next
                If ActiveChart.SeriesCollection.Count < 2 Then
                    ActiveChart.SeriesCollection.NewSeries
                End If
                   
                    ActiveChart.HasTitle = True
                    ActiveChart.ChartTitle.Caption = "='DG # 1'!$A$" & rownum
                    rfrnce2 = "='DG # 1'!$cellf$z:$cell$z"
Line removed to allow upload
                    ActiveChart.SeriesCollection(2).Values = Range(rfrnce2)
                    ActiveChart.SeriesCollection(2).MarkerStyle = xlMarkerStyleNone
                    ActiveChart.SeriesCollection(2).Format.Line.ForeColor.RGB = RGB(255, 0, 0) ' Line colour RED
               
                If b = 0 Or b = 1 Then
               
                On Error Resume Next
                If ActiveChart.SeriesCollection.Count < 2 Then
                    ActiveChart.SeriesCollection.NewSeries
                End If
                    c = c + 1
                    rfrnce2 = "='DG # 1'!$cellf$z:$cell$z"    'Adds lower limit to chart
 Line removed to allow upload
                    ActiveChart.SeriesCollection(3).Values = Range(rfrnce2)
                    ActiveChart.SeriesCollection(3).MarkerStyle = xlMarkerStyleNone
                    ActiveChart.SeriesCollection(3).Format.Line.ForeColor.RGB = RGB(255, 0, 0)
                End If
           
            End With
           
          c = c + 1
        Next b
       
    End With
↧
Viewing all 49895 articles
Browse latest View live
Search