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

How does one increment a variable for Columns A through I

April 8, 2020, 6:09 pm
$
0
0
I'm trying to store records that Match an input into an array to hold 9 fields of information.
I could use a For Next loop and a variable to grab each of the 9 fields of information to STORE in my array but I'm unsure how to go about using a variable to designate which columns (A through I) to copy the information to be stored.

I'm hoping for an alternative to designating a line for each field of information to be copied and stored as illustrated below.
HTML Code:
MatchesArray(1, RecNum) = Worksheets("FamilyTree").Range("A" & RowNum).Value
MatchesArray(2, RecNum) = Worksheets("FamilyTree").Range("B" & RowNum).Value
MatchesArray(3, RecNum) = Worksheets("FamilyTree").Range("C" & RowNum).Value
and continuing 6 more times.
Thanks for any tips
↧
Search

Macro to Convert IFNA and IFERROR to Values

April 8, 2020, 6:40 pm
$
0
0
I have a partner who is using a version of excel that is older then 2013 version and they can't read our model that has IFNA and IFERROR function all over the workbook. Is there a way I could get a macro that will convert them all to their values. Or something better then going into each worksheet and finding and replacing them with a IF statement in conjunction with ISNA and ISERROR functions
↧
↧

Run-time error '1004'

April 8, 2020, 7:32 pm
$
0
0
Please see attachment for a description of my problem. I am not sure what is wrong with the Macros. When I originally created them they worked fine. I made some changes to the worksheet and now they are not working. Do you have any ideas?

I have very limited knowledge of Macros and almost none with Visual Basic.

Thanks for your help.
Attached Files
↧

Trouble looping through content control blocks in MS Word to then export to Excel

April 8, 2020, 7:36 pm
$
0
0
Hello all,

I am attempting to write a macro that will allow me to type data in MS Word using groups of 25 content control blocks, then import that data into Excel in the next available or empty row, then moving to the next 25 blocks for the next free row, etc. I have partial success and I can accomplish my objective but the loop is not efficient and will not allow me automatically loop through groups of 25 blocks. I have to manually type in the number of blocks I want to loop through instead of just detecting the next 25 blocks. (these will always be in groups of 25 cc blocks). I at times might have hundreds or a thousand rows filled in the excel document so manually writing each set of blocks to loop through isn't efficient.

What I currently have, I map to and open a document from excel, this is necessary when working off my excel template.

Sub Trying_To_Loop()

Dim appWD As Object
Dim wddoc As Object
Dim i As Integer
Dim r As Integer
Dim rr As Integer


On Error Resume Next
Set appWD = GetObject(, "Word.application")
If Err = 429 Then
Set appWD = CreateObject("Word.application")
Err.Clear
End If

Set wddoc = appWD.Documents.Add(Template:="/Users/########/Library/Group Containers/UBF8T346G9.Office/MyExcelFolder/Product ID.docx", NewTemplate:=False, DocumentType:=0)
appWD.Visible = True
wddoc.Visible = True

appWD.DisplayAlerts = True
r = 1
rr = Sheets("Sheet1").Cells(Rows.Count, r).End(xlUp).Offset(1, 0).row
For i = 1 To 25 'this is where Im having to manually write the range of cc blocks, and what I want to automate.
Sheets("Sheet1").Cells(rr, r).Value = wddoc.ContentControls(i).Range.Text
r = r + 1
Next i
r = 1
rr = Sheets("Sheet1").Cells(Rows.Count, r).End(xlUp).Offset(1, 0).row
For i = 26 To 50 'same piece this is what I want to automate.
Sheets("Sheet1").Cells(rr, r).Value = wddoc.ContentControls(i).Range.Text
r = r + 1
Next I


wddoc.Close SaveChanges:=wdDoNotSaveChanges
wddoc.Quit


End Sub

Any assistance would be greatly appreciated. P.S. Im working with Office 365 on a MacBook Pro.

Thank you

/r
mason
↧

Move workbook to different location and get error 9

April 8, 2020, 7:45 pm
$
0
0
I use an Excel workbook to develop a game. I need to pass it via email to others who are not on our network. I emailed it to someone who ran it from the C:\Users\Owner\Downloads folder. It ran fine. I helped him (on the phone) to create a new, more permanent folder, C:\Mex Train. He moved the program to that location, which is the same I use on my computer. When he ran it he got an Error 9 - Subscript out of range. The highlighted text was at the beginning of the StartGame routine, which is the first subroutine called.

Sub StartGame()
Dim wsC As Worksheet
Set wsC = Workbooks("Corona Train Mar 30.xlsm").Sheets("Train") <<<<<<
Dim wsT As Worksheet

Application.ScreenUpdating = False
MyPlr = Cells(1, 16)

Again, it worked on his computer until we moved it, after which it failed on the third line. I tried changing the directory in code (ChDir = "C:\Mex Train") but got the same result. This workbook has only three sheets and doesn't call any other workbook. Any ideas?

Also, does anyone have a list of items that must be considered when installing on a different computer? Items like allowing Macros, Trust Center, References installed, etc. Right now I'm hit and miss on addressing those issues. Thanks.
↧
↧

Macro to email Several Sheets

April 8, 2020, 7:53 pm
$
0
0
I have written a macro to email sheets "Sales1 to sheet "Sales3"


The sheets must be saved as the as the name of the subject in B1 on sheet "Email"


I get a run time error & the following code is highlighted


I have attached sample data to make it easier for someone to see what I am trying to achieve


Code:
.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum

Code:
Sub Email_SalesReport()
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim Sourcewb As Workbook
    Dim Destwb As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim OutApp As Object
    Dim OutMail As Object
    Dim Stringbody As String
    Dim I As Long
    ztext = [bodytext]                              'read in text from named cell
Zsubject = [subjectText]
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    Set Sourcewb = ActiveWorkbook


 

    'Copy the ActiveSheet to a new workbook
 
    For I = Worksheets("Sales1").Index To Worksheets("Sales3").Index
        With Worksheets(I).Copy

   
   
    Set Destwb = ActiveWorkbook

    'Determine the Excel version and file extension/format
    With Destwb
        If Val(Application.Version) < 12 Then
            'You use Excel 97-2003
            FileExtStr = ".xls": FileFormatNum = -4143
        Else
            'You use Excel 2007-2013
            Select Case Sourcewb.FileFormat
            Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
            Case 52:
                If .HasVBProject Then
                    FileExtStr = ".xlsm": FileFormatNum = 52
                Else
                    FileExtStr = ".xlsx": FileFormatNum = 51
                End If
            Case 56: FileExtStr = ".xls": FileFormatNum = 56
            Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
            End Select
        End If
    End With

    'Change all cells in the worksheet to values if you want
     
      With Sheets(1).UsedRange
    .Value = .Value
End With
     
     
        Application.CutCopyMode = False


 

    'Save the new workbook/Mail it/Delete it
    TempFilePath = Environ$("temp") & "\"
  TempFileName = Range("B1") & Format(Now, "dd-mmm-yy h-mm-ss")
   

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)



    With Destwb
        .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
        On Error Resume Next
        With OutMail
            .To = Join(Application.Transpose(Range("F1:F4").Value), ";")

            .CC = ""
            .BCC = ""
            .Subject = Zsubject
          .Body = ztext

            '.Body = strBody
            .Attachments.Add Destwb.FullName
            'You can add other files also like this
            '.Attachments.Add ("C:\test.txt")
            .display  'Use .send to send automatically or  .Display to check email before sending
        End With
        On Error GoTo 0
        .Close savechanges:=False
     
    End With
      End With
     
        Next I
    'Delete the file you have send
    Kill TempFilePath & TempFileName & FileExtStr

    Set OutMail = Nothing
    Set OutApp = Nothing

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
   
    Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic


End Sub
↧

On/ Off button in VBA

April 8, 2020, 9:10 pm
$
0
0
Hi Everyone,

I need your assistance to build the on and off button macro, here i have attached the sample file for your reference.

so when I click the “On” button the off will hide and the range will be select in A1 is 1 or true, likewise if I select “off” button the entire oval shape should be in off. Help me to fix this.

Thank you
Raj
Attached Files
↧

Remove rows which do not occur in another sheet

April 8, 2020, 6:46 pm
$
0
0
Hi all,

Hoping to get some help with a filtering problem. My Sheet 1, Column A is text labels, and all other columns (besides labels in Row 1) are numerical values. I want to filter Sheet 1 so that all rows whose Column A text value does not occur in column A of Sheet 2 are deleted.

Can anyone help?

Thanks,

Peter
↧
Search

[SOLVED] Macro to extract Sheet Names to sheet "Sheet Names" from sheet4 to Sheet6

April 8, 2020, 10:38 pm
$
0
0
I have tried to write code to extract the names of sheet4 (Sales1) to sheet 6 (sales3) , but all the sheet names are extracted on sheet "Sheet Names"


It would be appreciated if someone could amend my code



Code:
Sub CopySheetNames()
Dim ws As Worksheet
Dim x As Integer
 Dim I As Long
For I = 4 To Sheets.Count - 1
x = 1
 
Sheets("Sheet Names").Range("A:A").Clear
 
For Each ws In Worksheets
With Worksheets(I)
    Sheets("Sheet Names").Cells(x, 1) = ws.Name
    x = x + 1
   
 End With
   
Next ws
  Next I
End Sub
↧
↧

[SOLVED] macro to connect a formula-row to an expanding dataset

April 8, 2020, 11:13 pm
$
0
0
Hi all,

I would like to have a macro that counts the number of rows filled with data of range1 and copies a range2 (a part of a row with formulas) to that number in the sheet.
By doing this i can connect the dynamic datarange to the formulas (that are on the right side of the dataset) and create a dshboard with the important information. Is this possible?

Any input is much appreciated.
↧

Printing multiple tabs at once with 1st tab print on both front/bk and the rest 1 page.

April 8, 2020, 11:18 pm
$
0
0
Hi everyone,

Is it possible to print an array of worksheets with the 1st set to print on both front and back, and the rest only print on 1 page?

Can any of the experts do up the above function code?

Much appreciated.

Regards,
Eugene
↧

Timer in userform, userform set ShowModal property false

April 9, 2020, 12:25 am
$
0
0
Good morning all,

I have the following code in a user form to start, stop and reset a timer.

the ShowModal property of userform1 must be set to False in IDE, otherwise the timer doesn't work. Is there a way to make the code so that the property of userform1 cab be set to True in IDE ? I need this so it will work with other user forms.

Hope someone can help :).

Code:
Option Explicit

Private CancelIt        As Boolean




Public Sub TimeLoop()


  Dim iDuration        As Integer
  Dim StartTime        As Variant
  iDuration = 30
  StartTime = Timer

  UserForm1.Show

  Do While Timer - StartTime < iDuration And Not CancelIt
      Label1.Caption = "Phone list will close in " & 30 - CStr(Int(Timer - StartTime)) & " seconds."
      DoEvents
  Loop

  If Not CancelIt Then
  StopTimer
      Application.DisplayAlerts = False
      Workbooks("Workbook1").Close savechanges:=False
      Application.DisplayAlerts = True

  Else
  StopTimer
      SetTimer
  End If

  Unload Me

End Sub

Private Sub CommandButton1_Click()
  CancelIt = True
  Call PhoneList.cmdContact_Click
Call PhoneList.txtSearch_Change
End Sub

Private Sub CommandButton2_Click()
CancelIt = True
      Application.DisplayAlerts = False
      Workbooks("Workbook1").Close savechanges:=False
      Application.DisplayAlerts = True
End Sub
The following code is in Module1.

Code:

Option Explicit

Dim DownTime            As Date
Sub SetTimer()
  DownTime = Now + TimeValue("00:01:30")
  Application.OnTime EarliestTime:=DownTime, _
                      Procedure:="ShutDown", Schedule:=True
End Sub
Sub StopTimer()

  On Error Resume Next
  Application.OnTime EarliestTime:=DownTime, _
                      Procedure:="ShutDown", Schedule:=False
                     
End Sub
Sub ShutDown()
Unload UserForm2
Unload UserForm3
Unload UserForm4
Unload UserForm5
Unload UserForm7
  Application.DisplayAlerts = False

  With UserForm1
      .Show
      .TimeLoop
  End With

End Sub
Sub Auto_Close()
Call StopTimer
End Sub
↧

Optimize and pairing

April 9, 2020, 1:09 am
$
0
0
Hi,

I have a bunch of subjects that I need to pair them up in a group of 2, but some subjects cannot be paired with some of them, the relationships between them is attached: The cells "FAIL" means that they cannot be paired together, e.g.: No6 and No3 cannot be paired together.

The subjects cannot be repeated in multiple pairs, i.e. if No7 is paired with No9, No7 cannot be paired with No1, No2, etc...

Are there any ways to optimize the pairing with the maximum number of pairs as an outcome?

Thank you so much!

Dexter
Attached Files
↧
↧

Excel macro for mail merge into individual word and pdf files

April 9, 2020, 6:02 am
$
0
0
Dear all,

I have got an excel file with data and macro to run so that mail merge in word to save individual merged document into one word file and one pdf file. The code tagged here could essentially do the work but the word file created is not a file saved in a closed mode so that when I moved it somewhere, it always said the file is open and denied the movement. I have to open the file and close it so that I can move it to another folder. Could anybody advise what the problem is?

Code:
Sub RunMailmerge1()
    Dim wdOutputName1, PDFFileName, wdInputName As String
    Dim x As Integer
    Dim nrows As Integer

    wdInputName = ThisWorkbook.Path & "\(2) B_mail merge.doc"
 
 

nrows = Sheets("Input data").Range("A" & Rows.Count).End(xlUp).Row - 1
 
 
    ' open the mail merge layout file
    Dim wdDoc As Object
    Set wdDoc = GetObject(wdInputName, "Word.document")
    wdDoc.Application.Visible = False


For x = 1 To nrows
    With wdDoc.MailMerge
        .MainDocumentType = wdFormLetters
        .Destination = wdSendToNewDocument
        .SuppressBlankLines = True
               
        With .DataSource
        .FirstRecord = x
        .LastRecord = x
        End With
        .Execute Pause:=False
    End With
   
   
   
       
    ' show and save output file
 
   
    'cells(x+1,2)references the first cells starting in row 2 and increasing by 1 row with each loop
    wdOutputName1 = ThisWorkbook.Path & "\Letter - " & Sheets("Input data").Cells(x + 1, 2) & ".doc"
    wdDoc.Application.Visible = False
    wdDoc.Application.ActiveDocument.SaveAs wdOutputName1
 
    PDFFileName = ThisWorkbook.Path & "\Letter - " & Sheets("Input data").Cells(x + 1, 2) & ".pdf"
    wdDoc.Application.ActiveDocument.ExportAsFixedFormat PDFFileName, 17

   
    Next x
    ' cleanup
    wdDoc.Close SaveChanges:=False
    Set wdDoc = Nothing
   

End Sub

Thanks!

Regards,
Carrol
↧

How to create VBA to send me an email once other people changes my VBA code in excel

April 9, 2020, 7:31 am
$
0
0
Is there a code to send me an email if someone change my VBA code in excel? I don't want to protect my VBA with password, so other way is to know who and what changes that someone in my code? tia.
↧
Search

Copy One Worksheet to Another Keeping Cell Format and Conditional Formating

April 9, 2020, 7:32 am
$
0
0
Greetings,
I am using the following code to copy data from wk:Master to wk:Calibration_Master. All works good because on wk:Master there are several cells that contain multiple font colors. Ex: Cell A3 has 4 lines of type. Line 1 is red font and lines 2-4 are black font. On wk:Calibration_Master I have several cells that are Conditional Formatted. When I run the code, the Conditional Formatting on wk: Calibration_Master is removed.
Code:
Sheets("Master").range("A3:BW1151").Copy Destination:=Sheets("Calibration_Master").range("A3:BW1151")
↧

[SOLVED] Show hidden tabs after clicking link to those tabs

April 9, 2020, 7:43 am
$
0
0
Please help me with a code in order to get to hidden worksheet tabs when clicking on a link.

Specifically, I want to be able to hide all of the RCO # tabs and when I click on the link on the Change Orders table in column L on the Estimate Overview Sheet the link will navigate to the corresponding hidden sheet.
Please see attached.

Thank you for your time
Attached Files
↧
↧

[SOLVED] Fix code that pulls in unwanted header data

April 9, 2020, 7:47 am
$
0
0
Hello!

I would like to fix my code so that instead of pulling in the headers from Worksheets CC, B, and C (below),

4-9 1.png

So it will only pull in the data from Column F excluding the header, like below:

4-9 2.png

Please note that I've noticed that my code only works when the headers are in row 1. However, they must be in row 5.

4-9 3.png

Here's the code below:

Code:
Sub ForASelection()
Dim wsOUT As Worksheet, ws As Worksheet
Dim wsKEEP As Worksheet
Dim NR As Long, Rw As Long, LR As Long
Dim TextToFind As String

Set wsOUT = ThisWorkbook.Sheets("OUTPUT")
Set wsKEEP = ThisWorkbook.Sheets("OUTPUT (2)")
wsOUT.UsedRange.Offset(2).Clear
TextToFind = wsOUT.Range("H1").Value
NR = 2

For Each ws In ThisWorkbook.Worksheets
    If ws.Name = wsOUT.Name Or ws.Name = wsKEEP.Name Then
        ' ignore output sheet
    Else
        wsOUT.Range("A2:F2").Copy wsOUT.Range("A" & NR)
        wsOUT.Range("A" & NR).Value = ws.Name
        With wsOUT.Range("A" & NR).Resize(, 4)
            .Merge
            .HorizontalAlignment = xlCenter
            .Interior.Color = 0
            .Font.Color = 16777215
            .Font.Bold = True
            .Font.Size = 14
        End With
        NR = NR + 1
         
  '***PROBLEM AREA I BELIEVE***
        With ws
            LR = .Range("F" & .Rows.Count).End(xlUp).Row
            For Rw = 2 To LR
                If .Range("F" & Rw).Value <> "" Then
                'If InStr(.Range("E" & Rw).Value, TextToFind) > 0 Then
                    wsOUT.Range("A" & NR).Value = .Range("A" & Rw).MergeArea.Cells(1).Value
                    wsOUT.Range("B" & NR).Value = .Range("C" & Rw).MergeArea.Cells(1).Value
                    wsOUT.Range("C" & NR).Value = .Range("D" & Rw).MergeArea.Cells(1).Value
                    wsOUT.Range("D" & NR).Value = .Range("E" & Rw).Value
                    NR = NR + 1
                End If
            Next Rw
        End With
    End If
Next ws

wsOUT.Columns.AutoFit
wsOUT.Activate
End Sub
I've also uploaded my spreadsheet if that helps.

Thank you!!!
↧

VBA - Escape characters for square bracket

April 9, 2020, 8:16 am
$
0
0
Hi, I am looking for a list of escape characters to denote special characters in strings

For example, the double quote escape character is "" if you want to put literally double quotes in the string

In particular, I am looking for the escape character for square brackets [ and ]

Any help?
↧

Trying to copy range of values from one WB to another by finding date in list

April 9, 2020, 8:31 am
$
0
0
I've got a mess here that I'm struggling through. I am trying to copy WB(Book1) Sheet(Net) Range(E7:E9) to WB(Book2) Sheet(Sheet1) corresponding col's C,D, E based on matching date from Book1 to Book2 range of dates col B (1/1(B4) to 12/31(B369)). So very stuck. Any help greatly apreciated! What I have so far:

Code:
Sub copytobook2()

Dim FindString As Date
Dim Rng As Range
Dim var As String
Dim copytarget As Range

'Find cell in Book2 that matches Book1 Date
Workbooks("Book1").Sheets("Net").Activate
var = Range("B4").Value
Range("E7:D9").Copy

'Open Book2 in background
Application.ScreenUpdating = False
Workbooks.Open "C:\Users\racas\Desktop\Book2.xlsm"
Workbooks("Book2").Activate
ActiveWorkbook.Sheets("Sheet1").Activate

'Copy Book1 values to Book2
    FindString = CLng(Date)
    With Sheets("Sheet1").Range("B3").Select
        Set Rng = .Find(What:=var, After:=ActiveCell, LookIn:=xlValues, LookAt _
        :=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase _
        :=False, SearchFormat:=False)
        If Not Rng Is Nothing Then
            Application.Goto Rng, True
        Else
            MsgBox "Nothing found"
        End If
    End With
   
copytarget = Rng.Offset(0, 1)
copytarget.Select
ActiveSheet.Paste

Workbook.Save
Workbook.Close

End Sub
Attached Files
↧
Viewing all 49820 articles
Browse latest View live
Search