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

Concat multiple cells in entire sheet.

$
0
0
I am needing help with creating a VBA code to Concat a spreadsheet. Below is what I am using, but I am trying to do this for the entire sheet, and have it automatically change d3 to d6, d9, d12... etc. Every 3 rows. This is for completing a mailing address that our billing system spits out in different places when printing to excel. The document could be 100 rows in length, or it could be 5000 rows, this is why i have the loop until a blank found in column C. Any help is appreciated.

The first cells in the sheet would be (C4," ",D4," ",C5," ",F5," ",G5) that the data is pulled from, then cut or copied in cell D3. I want it to replicate this for the rest of the sheet, but move down 3 rows every time until a blank is found in column C.

Range("D3").Select
ActiveCell.FormulaR1C1 = _
"=CONCAT(R[1]C[-1],"" "",R[1]C,"" "",R[2]C[-1],"" "",R[2]C[2],"" "",R[2]C[3])"

Dim BlankFound As Boolean
Dim x As Long

Do While BlankFound = False
x = x + 1

If Cells(x, "C").Value = "" Then
BlankFound = True
End If
Loop
Attached Files

VBA to make Excel sound noise when done with countdown

$
0
0
With help from a few nice members I was able to get my countdown timer to work well. The only thing I would like to do it to add a bell/buzzer for 10 seconds when a countdown is complete. I can get a simple ding, but not a real bell/buzzer type alert. I am running on a mac if that matters.

Toughts?
-Frank
Attached Files

Automatically open workbook and run macro---NOT WITH SCHEDULER

$
0
0
Question: IS it possible to write a VBA code that will live in my workbook to open my workbook (if it isn't already open) at a certain time, run my 'savesheet' macro (already lives in my workbook and works) and then close my workbook??

I do not want to use the windows scheduler for this task as I would like to share this workbook with many people and I don't have the ability to go onto each of their schedulers to set the automation.

Thank you!

Using Table with Find & Replace Macro

$
0
0
Hi folks!

I know this should be easy, but I just can't seem to get it to work.

My workbook is attached...here's what I need to do:

I want to have a table on the "ClientList" tab, 2 columns...column 1 is "Find" value, Coumn 2 is "Replace" value

I want to run this macro on the data in the "PrepSheet" tab so that the names in the "Account Manager" & "Customer" columns are changed appropriately.

I need the table because I have a lot of "Customer" replacements to make and arrays just aren't working for me.

Any help/guidance you can give me would be great! I've worked with macros a little bit, but I am far from being proficient.
Attached Files

[SOLVED] Is there any other alternate way of entering the range to the end

$
0
0
Hi Guys ,

Below macro is pasting the formulae in sheets which starts from _WT when i assign the code to button on other sheet its not putting the formulae to end.

Code:

Sub UpdatePO_Qty123()
Dim ws As Worksheet
    For Each ws In Sheets
        With ws
        If Right(.Name, 3) = "_WT" Then
            .Range("AO10").Formula = "=IF(IFERROR(VLOOKUP((A10&G10),'Master BOM1'!$A:$AA,22,0),"""")=0,"""",IFERROR(VLOOKUP((A10&G10),'Master BOM1'!$A:$AA,22,0),""""))"
            With .Range("AO10:AO" & Cells(Rows.Count, 10).End(xlUp).Row)
                .FillDown
                .Calculate
                .Formula = .Value
            End With
        End If
        End With
    Next
 
End Sub

I think something wrong in below code line . Please suggest any other way to write the code so that it fills the range AO10:AO , based on the contents of cell A1

For ex: if Column A has data till A20 so formulae should pe pasted till AO20 not on A21
Code:

With .Range("AO10:AO" & Cells(Rows.Count, 10).End(xlUp).Row)

How to Insert text/formula in to cells based on the text in the cell beside

$
0
0
Hi,

I have got a list of data in Sheet 2 that references cells in Sheet 1. I am using a couple of macros to insert rows and edit font/row sizes, etc. into Sheet 2.

I now need to insert the formula "=IF(MOD(ROW(),1)=0,INDEX(Sheet1!$C$4:$C$49271,ROW()/2),"")" into the cell in column A of every newly created row.

I will then need to insert a few new rules based on some other criteria. As this will then change the data that the above formula will reference, I need to copy and paste this information as a value before I do the next step.

The macro I am using to create the rows is below with the cell I am trying to add this formula to highlighted in red. From what I can figure out there is no way to add the formula directly within this macro and I will need to run a new one, but I am honestly completely lost. Can anyone shed some light on what I should do?



Code:

Sub InsertRow()
    Application.ScreenUpdating = False
    Dim LastRow As Long, x As Long
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    For x = LastRow To 2 Step -1
        If Cells(x - 1, 4) Like "*.*" Then
            Rows(x).EntireRow.Insert
          With Cells(x, 1)
                .Font.Size = 12
                .RowHeight = 25
                .Font.Name = "Rockwell"
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlTop

            End With
            With Cells(x - 1, 2)
            .Resize(2, 1).Merge
            .Font.Size = 22
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            End With
            With Cells(x - 1, 3)
            .Resize(2, 1).Merge
            .Font.Size = 48
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            End With
            With Cells(x - 1, 4)
            .Resize(2, 1).Merge
            .Font.Size = 26
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            End With
            With Cells(x - 1, 1)
            .Font.Size = 26
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlBottom
            .RowHeight = 35
            End With
        End If
    Next x
    Application.ScreenUpdating = True
End Sub

Using Excel File one device.

$
0
0
Hello VBA Experts,
Is there any VBA Code for Excel file only use one device or two devices?
Thanks.

Increment the cell reference in an equation in Excel VBA

$
0
0
I want to calculate the quadratic regression for a number of columns and display the results. I want to be able to increment ONLY the column referenece (Letter E) from linest equation and the row reference from .Range("B6:D6"). (Number 6 would increment and the columns would stay the same). The code I have so far is shown below. This works well just for column E and displays it in range B6:D6. I want to repeat this by looping through the columns (E to GT) in the linest formula and display the corresponding results in B[rownumber] : D[rownumber].

Code:


Dim X
X = Application.Evaluate("=LINEST('V Az or H El'!$A3:$A42,'V Az or H El'!$E3:$E42^{1,2})")
Worksheets("Quadratic Regression").Range("B6:D6") = X

How do I change the code to suit what I'm trying to do?

Is it possible to open an validation popup in code?

$
0
0
Hello,

Is it possible to open a validation popup or popdown, whatever it is called, to show the validation items, in vba code?
Its on macos excel.

For now I have nothing to show, because I don’t know how to do it.
Any pointers or link how to start with?

Thank you.

Setting print area (for PDF export) based on conditions

$
0
0
I have a ton of cells and pivot charts that calculate/populate based on data from an Access Database. This data is used to create monthly reports

Every product type has its own calculations and charts, but there are some months where a product is not produced so its specific calculations are zero and its pivot charts are blank

I have code that generates a PDF, but I only want it to generate a PDF for the products that were produced instead of all the products, essentially excluding calculations that are zero

This is where I am having issues

I want to have code that determines a product has been manufactured and add that section to the print area which is used to generate the PDF

I've tried essentially creating check boxes that used conditional IF THEN statements to set the print area, but there are too many products/combinations to create individual IF statements for each scenario

Is there a way to tell excel this is the print area, but if this condition is met (product is created) add it to the print area? Instead of using a replacement effect like an IF statement?


Alternatively is there a way to have excel export and the user can still select the pages via a macro?

-Nathan

Restrict paste type in only 1 sheet

$
0
0
Hi guys & girls!

I have a worksheet that people use all the time to paste lots of information into.

The most time-consuming part is when you click, hold and scroll down to highlight everything that you want to copy, the data is similar to what you'd find in https://xdcc.horriblesubs.info/.
If you use Crtl-A then copy, it cause problems when you paste because of all the extra stuff that gets in the sheet.

While wondering if it is possible to make this quicker using Ctrl-A then on excel then Paste Special to Text, i experimented with:

Code:

    ActiveSheet.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

Then i'd shortcut the macro with Ctrl-v.


This works, but it causes issues because this effects all the other sheets in the workbook and it also activates on other open workbooks.

How can i make this work for only 1 sheet called "Dump"?

Or, is there another code i can use on that specific sheet that would automatically "paste as text" whenever someone does Ctrl-v?

Thanks!!

Use range.copy_ destination:= ... instead of range.copy range.paste is not working. Help!

$
0
0
Hi all,

i have tried to build a makro which replaces strings( sh.Cells(j, 4) -> list of 42 to words = find what ) in other strings ( sh.Range("A2", t) -> list of words where part f strings should be replaced ), with strings ( sh.Cells(j, 5) -> list of 42 words = replace with).

The issue i am having now is that when copying sh.Range("A2", t).Copy so a range in a column from the "A2" to the "last cell with value".
I would like to use the

Code:

sh.Range("A2", t).Copy
Destination:=sh.Range("B2")

instead of

Code:

sh.Range("A2", t).Copy
Range("B2").PasteSpecial
Application.CutCopyMode = False

But it is not working and saying " Compile Error _ expected expression "
Does somebody now what i do wrong and why it is not working?
Cheeers in advance .:)

Here is the code

Code:

Dim sh As Worksheet
Dim t As Range
Dim z As Range
Dim j As Integer

Set sh = Workbooks("pension_name_replacer.xlsm").Sheets("Input")
Set t = sh.Range("A" & Rows.Count).End(xlUp)
Set z = sh.Range("B" & Rows.Count).End(xlUp)

sh.Activate

sh.Range("A2", t).Copy
Range("B2").PasteSpecial
Application.CutCopyMode = False
   
    For j = 2 To 43
       
        sh.Range("B2", z).Replace sh.Cells(j, 4).Value, sh.Cells(j, 5).Value, xlPart, , False, , False, False
           
    Next j
       
End Sub

VBA Alternative to Vlookup??

$
0
0
Have a file that we get from a client that I need to run calculations on.

I need to basically do a vlookup based on the "fdmc_transit_report" tab of what starts in column C, and moves down, and then put in starting Q2, what would be on "DC Data" starting B2.

The code that appears in column C of FDMC tab is what is in column A of the DC Data tab.

The Source data on the FDMC tab will be varied in the number of rows that appear

Is there a way to populate the data that is in column B of the DC tab into column Q without doing a vlookup (or xlookup, etc)???
Attached Files

Command Button, backcolour and picture

$
0
0
Hello,
I'm having a disagreement with a command button. I want to fill the button with an image or, barring that, fill the shape with a colour. I have tried both and both times there remains a border of grey/white.
Is it possible to fill a command button with an image or colour?
More and more I believe that VBA was an afterthought to Microsoft.
Anyway, if there are options - vba or win api - or if that's it, thanks for listening.
Happy eve',
Shawn
P.S. I realise that I could use a label, but then I'd need to write the code to animate it.

Im trying to create a Macro Loop using Optimizer

$
0
0
Here's my code so far;

Code:

Sub Solver_Final()
'
' Solver_Final Macro
'
' Keyboard Shortcut: Ctrl+Shift+O
'
        SolverReset
        SolverAdd CellRef:="$I$1", Relation:=2, FormulaText:="1"
        SolverAdd CellRef:="$B$1:$H$1", Relation:=3, FormulaText:=".1"
        SolverOk SetCell:="$I$4", MaxMinVal:=1, ValueOf:=0, ByChange:="$B$1:$H$1", _
        Engine:=1, EngineDesc:="GRG Nonlinear"
        SolverSolve True
End Sub


I want to make a loop that will go through each row until the cells are empty running the optimizer.
all referenced cells in the optimizer should remain the same however " SolverOk SetCell:="$I$4", MaxMinVal:=1, ValueOf:=0, ByChange:="$B$1:$H$1", _" should shift down a row each loop.

Lastly I would like to paste the value of the "I" column of the row being referenced. so that when it loops again the value of row "I"of the previously referenced row is not influenced by the loop.

Calculate days between two dates and enter nr of days in another textbox

$
0
0
Good afternoon

Once again im grateful for everyone participating in this forum. you are all the best and thanks for always helping.

i have a textbox already configured to show the system date. so everyday when u open the date will change.

we always get certain documents where there is a date stamp and then u have to manually calculate 90 days from there.

if it is 90 days and more then the clearance paper expired, then u must apply for a new one.

so i want when i open the userform, enter the date on the "clearance" it must tell me how many days have lapsed and if more than 90 days from that date

show "Expired" on a label i created.

i attaching the file where i already put some vba codes

i managed to have the days calculated.

however if the days you enter the date and it must be a date before todays date, then only when the days reach 90 and more it must show "Expired" in the label

i already created the label. i just need help with the coding
Attached Files

Export the number of pages in subfolders for all documents to a spreadsheet

$
0
0
Hi,

I want my macro to run through all the documents in a folder and it's subfolders and export a list that looks like:

Filename Number of pages
File 1 8
File 2 3
File 3 5

My current code works through just the folder and the subfolder:

Code:

Sub CountPagesInDocs()
Const wdStatisticPages = 2
Dim wsStats As Worksheet
Dim objWrd As Object
Dim objDoc As Object
Dim strFileName As String
Dim strPath As String
Dim arrStats()
Dim cnt As Long

    strPath = "C:\Users\ZA\Desktop\Testing word page count\" ' change this to the folder/path where you are storing your Word documents

    strFileName = Dir(strPath & "*.doc*")
   
    Set objWrd = CreateObject("Word.Application")
   
    objWrd.Visible = False
   
    Do While Len(strFileName) <> 0
        ReDim Preserve arrStats(1 To 2, cnt)
        Set objDoc = objWrd.Documents.Open(strPath & strFileName)
       
        arrStats(1, cnt) = strFileName
       
        arrStats(2, cnt) = objDoc.ComputeStatistics(wdStatisticPages)
       
        objDoc.Close
        cnt = cnt + 1
        strFileName = Dir
    Loop
   
    objWrd.Quit
   
    Set objWrd = Nothing
   
    Set wsStats = Sheets.Add
   
    With wsStats
        .Range("A1:B1").Value = Array("Document Name", "No of Pages")
        .Range("A2:B2").Resize(UBound(arrStats, 2) + 1).Value = Application.Transpose(arrStats)
        .Range("A1:B1").EntireColumn.AutoFit
    End With
   
End Sub

Thank you for your help.
Z

[SOLVED] VBA - data logging

$
0
0
Hello my friends.
I'm a total VBA beginner.
I need help.
I want data to be automatically written + 1 column each time
Attached Files

How to delete all files in folder - except few listed files

$
0
0
Hi all,

I have a code to clear files in folders. Now i need to add one condition to it,
The condition is, i have file name updated in cells "A1 to A10".
i might enter only two file name or all of 10 file names.

macro should not delete these files listed in this range, apart from these names it can delete rest.

I have attached code, but cannot attach the work book.

appreciate if someone can help.
Code:

Sub Test2()



Application.Calculation = xlCalculationAutomatic

Call GetDesktop

ThisWorkbook.Worksheets("Path List").Range("E9").FormulaR1C1 = "=GetDesktop()"

Application.Calculation = xlCalculationAutomatic



MyPath = ThisWorkbook.Worksheets("Path List").Range("E9").Value

   
       
        Set FSO = CreateObject("Scripting.FileSystemObject")
        Set Myfolder = FSO.GetFolder(MyPath)
        Set myfiles = Myfolder.Files
       
       
        For Each file In myfiles
            FileExt = FSO.GetExtensionname(file)
         
            If FileExt = "txt" Or FileExt = "xlsx" Or FileExt = "xls" Or FileExt = "doc" Or FileExt = "docx" Or FileExt = "xlsm" Or FileExt = "ppt" Or FileExt = "csv" Or FileExt = "pdf" Or FileExt = "xlsb" Or FileExt = "jpeg" Or FileExt = "PNG" Or FileExt = "JPG" Or FileExt = "tif" Then file.Delete
        Next
 
   
MyPath1 = ThisWorkbook.Worksheets("Path List").Range("E10").Value

       
        Set FSO = CreateObject("Scripting.FileSystemObject")
        Set Myfolder = FSO.GetFolder(MyPath1)
        Set myfiles = Myfolder.Files
     
        For Each file In myfiles
            FileExt = FSO.GetExtensionname(file)
            'If FileExt = "txt" Or FileExt = "xlsx" Or FileExt = "xls" Then File.Delete
            If FileExt = "txt" Or FileExt = "xlsx" Or FileExt = "xls" Or FileExt = "doc" Or FileExt = "docx" Or FileExt = "xlsm" Or FileExt = "ppt" Or FileExt = "csv" Or FileExt = "pdf" Or FileExt = "xlsb" Or FileExt = "jpeg" Or FileExt = "PNG" Or FileExt = "JPG" Or FileExt = "tif" Then file.Delete
        Next
 
   
 
   
    Set FSO = Nothing
    Set myfiles = Nothing
    Set Myfolder = Nothing
   
    MsgBox " Files from all of the Folders are Cleared ! "

       
   
End Sub

Sending outlook emails through VBA with multiple bodies and a table

$
0
0
Hi,

I am trying to find a way to sent a dunning email through a VBA macro.

The email should look like this:
Quote:

"Dear,

Please be advised that the following invoice is overdue:

[Table with overdue invoices]

Please check and inform us when we can expect the payment.
If the payment has already been made, please inform us with the details and disregard this email.


Thank you & Best regards,"
[outlook Signature]

This is currently my VBA macro:
Quote:

Sub Maildisplay()
Dim outlook As Object
Dim newEmail As Object
Dim xInspect As Object
Dim pageEditor As Object


Set outlook = CreateObject("Outlook.Application")
Set newEmail = outlook.CreateItem(0)


With newEmail
.To = Sheet2.Range("B1").Text
.CC = Sheet2.Range("B2") & ";" & Sheet2.Range("B3") & ";" & Sheet2.Range("B4") & ";" & Sheet2.Range("B5") & ";" & Sheet2.Range("B6")
.BCC = ""
.Subject = "Overdue invoices"
.Body = "Dear," & (Chr(13) + Chr(10)) & (Chr(13) + Chr(10)) & "Please be advised that the following invoices are overdue:"
.display

Set xInspect = newEmail.GetInspector
Set pageEditor = xInspect.WordEditor

Sheet1.Range("B2:E5").Copy

pageEditor.Application.Selection.Start = Len(.Body)
pageEditor.Application.Selection.End = pageEditor.Application.Selection.Start
pageEditor.Application.Selection.PasteAndFormat (wdFormatPlainText)
.display
Set pageEditor = Nothing
Set xInspect = Nothing

End With
Set newEmail = Nothing
Set outlook = Nothing
End Sub
So basically I am trying to find a way to enter a .body after the part where I copy the table into the email.
However, VBA does not allow me to simply write .body 2 times.

Does anybody know a way to insert the text after the table with overdue invoices?
Viewing all 49872 articles
Browse latest View live