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

Using MACRO to filter and copy the data.

$
0
0
hi,

I am having a serious trouble in my MACRO, i have tried to watch some youtube videos but nothing works.

The Idea is, I want the MACRO to go to a specific column and filter it, lets say with the criteria 2934, and then, take whatever range is shown (it is not always the same, and sometime may not appear) and paste it to another sheet.

Everything seems great, however, if no do data are available for the criteria 2934, it will copy the whole range/table without any filter! and this will cause a huge mess in my data.

I have tried to use the following code, but it is not working + sometime give me the opposite result (for example, if there is a data for the criteria, it will show the message box!).

here is my code:



Dim autofilter As Range
Dim rng As Range

Sheets("Items").Select
ActiveSheet.Range("d2").autofilter Field:=4, Criteria1:="2934"

If autofilter Is Nothing Then

MsgBox "No data available"
Sheets("Items").Select
ActiveSheet.ShowAllData
Exit Sub

Else

Then I have continued my code to copy the range ..etc.

Copy data from first cell in range then move to next cell

$
0
0
Hi there,
sorry its been along time since i've dabbled in VBA so i'm very rusty.

i'm working with a 4 sheets.
sheet 1 is used as a register.

sheets 2,3 & 4 are 3 different types of inspection sheets.

i want to filter the data in sheet 1, then from the first cell in the filtered data at range A copy this to sheet 2 (if working with sheet 2)
then move to Range C, D & E, copying this data to sheet 2.

i then have a macro to print the sheet to PDF based upon sheet 1 range F data.

i then want the macro to move to the next cell in range A of the filtered data and loop the process. it then prints another PDF.

once it gets to a blank cell i need it to stop.

i've totally forgotten how to do this.

can anyone help refresh me with some code i can work with.
thankyou

[SOLVED] Find empty column and drag formula to the last row

$
0
0
Hi all, appreciate someone help on this matter. For example, row A1 - Z1 got information (variable every time. Could be A1 - X1). I want my VBA to identy next empty column, in this case should be AA1, and marked as "X". Then the next step should be drag the formula until the last row in column AA.

how to do clear contents for Merge cells

$
0
0
Hi All,
Hope you are doing great, please assist on attached file i have to do clear contents but cells are merged.
Attached Files

Toggle Button Self

$
0
0
I am trying to post a code into 200+ different toggle buttons, involving the toggle button affecting itself - applying a more vibrant color for being active. But this involves going through each button one at a time and updating each individual value...
Update ToggleButton6 to ToggleButton7 and so on and so on.... 800+ times...

Is there a code where the togglebutton knows it is referring to itself? ActiveToggleButton?

Web scrapping through VBA from a particular cell of HTML table

$
0
0
I have a VBA code (thanks to rorya for making it workable for me) for scraping web data from a web page. This VBA is working fine. Now the data is moved to another page with some more fields. Form fields i.e. Train no., Date and a Radio button 'Departure' required to be checked/filled for populating the desired table. Radio Button.png. I have tried to modify the code but unable to click the Display button as there is no ID. How to submit the form, please suggest.
Further data from one cell (loco no.) is required to be copied in the Excel sheet/cell Loco Number.png. How to achieve the above goal, please help. The Excel sheet is attached herewith (which I am trying to modify but stuck at Radio button).
Attached Files

How to prevent VBA function calls from reevaluting when worksheet opens up

$
0
0
I have some VBA functions which print a string on the cell from where it's called.

For e.g.

Code:

Public Function PrintStuff() As String

        Val1 = Application.ThisCell.Offset(0, -3)
        Val2 = Application.ThisCell.Offset(-1, -3)

        If (Val1 < Val2) Then
                PrintStuff = "Lesser"
        Else
                IsDirRevd = "Not Lesser"
        End If
 
End Function

Now let's say I call this from Cell A1 as "=PrintStuff()", then you see either Lesser or Not Lesser in Cell A1

Now I call this function & other similar functions many, many times in my worksheet.

What I want is that once the function call is evaluated & something is written on to the cell, it becomes permanent. i.e. it doesn't reevaluate the function everytime the sheet is opened - is this possible

Why I want this is because sometimes when I reopen the sheet, Lesser gets changed to Not Lesser & vice versa. This is inspite of the cells which the function checks not changing. I clear out the formula call from the cell, & rewrite the call, the string goes back to what was originally being printed.

So is there a way to freeze the output of a VBA function call?

[SOLVED] Find partial text and replace entirely

$
0
0
Anyone have any idea to find partial text and replace it entirely. For example, in first row, the header contain Apple Juice. I want to make it become "Apple" only. Below code simply does not work & I cannot put the exact word because it has alot of Apple products. To simplify, I want to find all the header contain word " Apple" and replace with only "Apple".

Code:

Range("A1:AZ1").Replace What:="Apple", Replacement:="Apple"

read pivot's current sort settings

$
0
0
Hi all,

Is it possible to read a pivot's ".AutoSortPivotLine" like it can be done with ".AutoSortField" and ".AutoSortOrder"?

Sort.PNG

My pivot has "Year" as a columnfield, so besides sort order and sort field, I want to read which year it is currently sorted by...

The name of a shape is in a cell and I want to indirectly reference it in vba

$
0
0
Hello amazing people of the VBA world, I'm slowly getting better at VBA and understanding it but i'm getting a bit stuck on this particular thing and unsure why it's not working.

I've been able to indirectly reference a cell with a shape name before in order to show/hide a given shape so i know the code i wrote works, however when I try to apply it to this particular bit of code it doesn't work.

The shape I want to move is called "rya1" and the cell location to move it to is located in "AH24". When I directly reference the shape name this code works perfectly:
Code:

Sub reflectiona()
Dim sh As Worksheet, myPic As Shape
    Set sh = Sheets("Reflections and rotations")
    Set myPic = sh.Shapes("rya1")
        With myPic
            .Top = sh.Range(sh.Range("AH24").Value).Top
            .Left = sh.Range(sh.Range("AH24").Value).Left
        End With
End Sub

I want the shape name (because it will change) in cell "AH25" and then for the VBA to pull the name from that cell and use that shape in the code - this is what I wrote but it wasn't working.

Code:

Sub reflectiona()
Dim sh As Worksheet, myPic As Shape
    Set sh = Sheets("Reflections and rotations")
    Set myPic = sh.Shapes.Range(sh.Range("AH25").Value)
        With myPic
            .Top = sh.Range(sh.Range("AH24").Value).Top
            .Left = sh.Range(sh.Range("AH24").Value).Left
        End With
End Sub

Anyone any ideas why please?

code involving two workbooks, runs correctly from one workbook but not the other

$
0
0
Hello All,

My first time posting here and very much a beginner in the VBA world.

I have some code that gets some cell references from one workbook in order to reference a cell in another workbook.

For some reason running it from the first workbook it wont let me select the cell in the second one, but if i reverse things and run the code from the second workbook, it works fine.

I dont know what I have wrong! any advice would be appreciated. I need it to run from the first one for various other reasons further down the line.


Code:

Sub copyOut()
   
    Workbooks("200117_Pricing Sheet.xlsm").Sheets("Cash Flow").Activate

    Set startMonth = Application.InputBox(prompt:="pick month", Title:="Start month", Type:=8)

    Workbooks("200117_Xylo Sales Cash Flow.xlsm").Sheets("Sales and Expenditure").Activate
   
    Set salesMonth = ActiveSheet.Range("a9").EntireRow.Find(startMonth)
   
    Set jobName = Application.InputBox(prompt:="pick job", Title:="Job Name", Type:=8)
   
    Cells(jobName.Row, salesMonth.Column).Select
   
   
End Sub

Filter the Range, COPY it and Paste in another sheet,

$
0
0
Hi

I want to autofilter the data and then copy this dynamic range and paste it to another sheet, however, I have an issue which is after filtering the data, the MACRO is copying the unfiltered data and leaves the filtered ones (which they are the one that I need to copy).

here is my code:

Code:

Sub cont()

    Sheets("Items").Select
       
'To Identify if there is a Range or it is an empty one
    Dim FF As Range
    Dim BB As Integer
    Set FF = Range(Range("d1"), Range("d1").End(xlDown))
    FF.autofilter field:=4, Criteria1:="221311"
    BB = WorksheetFunction.Count(FF.Cells.SpecialCells(xlCellTypeVisible))
    If BB < 1 Then
'if no Data
    MsgBox "No data available"
    Sheets("Items").Select
    ActiveSheet.ShowAllData
    Sheets("Main").Select
    Exit Sub
   
                        Else
                       
'Now all the data are available, LETS COPY

    Set rng = ActiveSheet.autofilter.Range
    rng.Offset(3, 0).Resize(rng.Rows.Count - 3).Copy
             
'first will define the empty cell
    Sheets("Analysis Basis").Select
    Dim lastrow As Long
    lastrow = Range("a1000000").End(xlUp).Row
    Cells(lastrow + 1, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'second will paste
    ActiveSheet.Paste
   
'TO remove all filters
    Sheets("Items").Select
    ActiveSheet.ShowAllData
    Sheets("Main").Select

    End If

End Sub

How to detect if i have float number or integer in cell value

$
0
0
Hi Guys,

i have a function:

Code:

Function CheckVariableType(NamedRange, VariableType) As String

    Dim VarValue As String
   
    VarValue = Application.Range(NamedRange).Value
   
    ''boolean handler
    If VarValue = "Yes" Or VarValue = "No" Or UCase(VarValue) = "FALSE" Or UCase(VarValue) = "TRUE" Then
        If VariableType <> "boolean" Then CheckVariableType = Join(Array(NamedRange, VariableType, "boolean"), Chr(2)): Exit Function
    End If
   
    ''float and integer handler
    If IsNumeric(VarValue) Then
       
        ''float
        If VarValue mod  <> 0 then
            If VariableType <> "float" Then CheckVariableType = Join(Array(NamedRange, VariableType, "float"), Chr(2)): Exit Function
        End If
       
    End If
   
    CheckVariableType = 0
   
End Function

NameRange is named range name and Var Type is my baseline from workbook provided.

In the function i am trying to identify based on cell value of named range what kind of variable i have.
For boolean it is easy as you can see but now i have to identify if variable like "30" is a number and also if we have 30,05 like float or maybe this is integer.

How to do this?
Please help,
Jacek

Collate information, send in email

$
0
0
Hey,

I have the below code that when you highlight a role and run the macro, its opens a new outlook email and paste the relevant data in place to let a client know their package has been dispatched.

Code:

Sub GalleryTracking()
  'This assumes that Outlook is already open to simplify the code
  '
  'The 'Font Name' and 'Font Size' attributes are variables obtained from the Spreadsheet
 
  Dim OutApp As Object
  Dim OutMail As Object
  Dim var As Variant: var = Selection.Value
  Dim sBody As String
  Dim sFontName As String
  Dim sFontSize As String
 
  'Set the Font Name and Font Size
  sFontName = "Calibri"
  sFontSize = "11"
 
 
  'Get the Email Body from the cell
  sBody = "Hey" & " " & var(1, 1) & vbCrLf & vbCrLf & _
          "Your item has been dispatched. Please find the tracking details below (Please allow 12hrs for tracking to go live): " & vbCrLf & vbCrLf & _
          "consignment number: " & var(1, 26) & vbCrLf & vbCrLf & "Please track here:  " & " https://www.tnt.com/express/en_gb/site/shipping-tools/tracking.html?searchType=con&cons=" & var(1, 26) & _
          vbCrLf & vbCrLf & _
          "IMPORTANT: Please note that when signing for the goods you must ensure you're satisfied with the packaging, if it looks damaged in any way please sign for as 'damaged'. Please open your parcel with great care, particularly when using a knife to ensure that it does not cut too deeply into the parcel damaging the item. You must inspect the goods promptly and relay any issues to us within 24 hours, quoting reference " & var(1, 3) & "." & vbCrLf & vbCrLf & _
  "Have a great day, very best regards,"
  'Replace ASCII NEW LINE with HTML NEW LINE
  sBody = Replace(sBody, vbCrLf, "<BR>")                    'Converts text body to HTML
  sBody = Replace(sBody, vbLf, "<BR>")
  sBody = Replace(sBody, vbCr, "<BR>")
 
 
 'Attempt to create an Outlook object
  On Error Resume Next
  Set OutApp = GetObject(, "Outlook.Application")
  If Err.Number <> 0 Then
    Err.Clear
    MsgBox "NOTHING DONE.  The Outlook Object could not be created from Excel." & vbCrLf & _
          "Try again when Outlook is open."
    Exit Sub

  End If
  On Error GoTo 0
 
 
  'Create the Outlook Mail Object (using the default Email account)
  Set OutMail = OutApp.CreateItem(0)
 
  'Grab the Signature
  OutMail.Display                'Creates .HTMLbody containing the signature

  'Determine the values to be sent
  With OutMail
    .To = var(1, 6)
    .CC = var(1, 13)
      .Subject = "Your Order Has Been Dispatched"
   
    'Put New .HTMLbody (containing font information)  around sBody (HTML body) and in front of the signature .HTMLBody
    ' .HTMLBody = "<p style='font-family:" & Arial & ";13:" & sFontSize & "pt'>" & sBody & "</p>" & .HTMLBody    'Original - did not compile
      sFontName = "Calibri"
      sFontSize = "11"
    .HTMLBody = "<p style='font-family:" & sFontName & ";font-size:" & sFontSize & "pt'>" & sBody & "</p>" & .HTMLBody
   
    .Display
   
    '.Send - comment out the 'Display line' if you want to send
  End With
 
  'Clear the Object Pointers
  Set OutMail = Nothing
  Set OutApp = Nothing



End Sub

We are now going to be doing it a different way and contacting the branch with a list of items that were dispatched instead. So i need to do something similar so that when i highlight a group of rows and run it, it displays something along the lines of " The below clients items have been dispatched" and then a list of clients names, their reference and their tracking numbers. Lets just say those fields are in columns A,B and C to make it easier.

The email address will be similar to the above where it will be located in a cell, so if that can stay as data being pulled through, rather than a static one, thatd be great.

Thanks for any help you can provide,

Marc

Hyperlink - VBA - Automatically copy - Help

$
0
0
Hi All,

I need to copy data from sheet 1 A1 and B1 to Sheet 2 B2 and C2 ( sheet 2 cells are fixed), I want to be able to do this by clicking a hyperlink on Sheet 1 in C3

I need this to continue in each row going down in sheet 1, so Sheet 1 A2 and B2 with a hyperlink to copy to sheet 2 B2 and C2, and so on.

The cells in sheet 2 will not change

I don't want to have to create a button from each row in sheet 1 ..

Does it make sense ?

Is this possible ?

Thanks
Attached Files

Compare two groups of data

$
0
0
Hello All,

I have two groups of data AB and DE. I want to write a vba macro to compare them in a way shown in figure. the situation is little difficult when i have duplicate names like Pcm and Tcm. help me to figure out with this. In the row 8 the light yellow highlighted will considered as same

thank you
Attached Images
Attached Files

User Form needs to update active sheet table.

$
0
0
I received help on this from this forum previously. The User Form works on sheet named "1". I need to have 100 tabs in this workbook all exactly the same. To summarize on the Summary sheet. The issue I'm having now is When you open the User Form on Sheet 2 it works but updates the table on Sheet 1. I need the copied sheets to update the table on their sheet. Is this just a change in coding to Active Sheet? If so where at? I am new to VBA coding and trying to learn. Any advice would be appreciated.
Attached Files

Need help with adding two formula to the below macro

$
0
0
Greetings

I have this macro that I need to add to two lines formula pleaea

I am not sure if am doing this correctly

-----------------------------
Sub MacroTest()

'Sheets("Analysis").UsedRange.Offset(1).Clear'
Application.DisplayAlerts = False
On Error Resume Next
Worksheets("RaceData").Delete
On Error GoTo 0
Application.DisplayAlerts = True

Worksheets("Racescrape").Copy Before:=Worksheets(1)

With Worksheets(1)

.Name = "Racedata"

LR = .Cells(Rows.Count, 1).End(xlUp).Row

Columns("J:J").EntireColumn.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

On Error Resume Next
SR = .Columns(1).Find("Tab", LookIn:=xlValues, Lookat:=xlPart).Row
On Error GoTo 0

If IsError(Z) Then GoTo Quit:

FindLoop:

LR = .Cells(Rows.Count, 1).End(xlUp).Row

If SR > LR Then GoTo Quit

On Error Resume Next
ER = 0
ER = .Range("A" & SR + 1 & ":A" & LR).Find("Tab", LookIn:=xlValues, Lookat:=xlPart).Row
On Error GoTo 0

If ER = 0 Then GoTo Quit

V = ER - SR

If V <> 27 Then


If V < 27 Then
.Rows(ER - 5 & ":" & ER + 21 - V).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

Else
.Rows(SR + 23 & ":" & ER - 5).EntireRow.Delete

End If
End If

Range("J" & SR + 1 & ":J" & SR + 22).FormulaR1C1 = "=IF(RC[-1]="""","""",(RC[-2]+RC[-1])/2)"
Range("J" & SR + 1 & ":J" & SR + 22).Value = Range("J" & SR + 1 & ":K" & SR + 22).Value

SR = SR + 27

GoTo FindLoop

Quit:
.Range("A:Cr").EntireColumn.AutoFit
End With

End Sub


I need to add two lines of formula

Col L:L

=SUM(--MID(SUBSTITUTE("-"&N6,"-",REPT(" ",15)),{15;30},15))/2

Col N:N

=SUM(--MID(SUBSTITUTE("-"&N6,"-",REPT(" ",15)),{15;30},15))/2


Trust that am doing this correctly

regards

raj
Attached Files

Macro to include dashes into identification number

$
0
0
SOLVED!

Hey I am trying to include dashes into an identification number based on the number of characters in the cell. For example I want to turn A12010 to A1-20-10 or A120010 to A1-200-10.
The identification numbers will only ever be 6 or 7 characters long with the first and last two characters being separated by dashes. Here is my code

Code:

Sub ReplaceDash()
    Dim Cell As Range
    For Each Cell In Selection
        If Len(Cell) = 6 Then
            Cell.Value = Left(Cell,2) & "-" & Mid(Cell,3,2) & "-" Right(Cell,2)
        ElseIf Len(Cell) = 7 Then
            Cell.Value = Left(Cell,2) & "-" & Mid(Cell,3,3) & "-" Right(Cell,2)
        End If
    Next
End Sub

Sorry I am new to this. Is this not a correct approach?

VBA Script to fix formulas in multiple files with different sheet names

$
0
0
Good day all, first post and TBH, my VBA skills are limited to googling, finding something similar to my needs, and editing through trial and error until it works. However, I'm not having any luck with my current issue.

I currently maintain 300 excel files we use to track approximately 4000+ associates (20-60 tabs within each file) by their team/supervisor. Within each file, each sheet contains the associate's name, which is creating an issue I am having in trying to fix formulas when they are hardcoded in error (normally due to a user copying and pasting them incorrectly from one file to another). I'd like to create a global macro to fix all of the formulas within each file, but due to the sheet names in each file being different, I can't create record a macro in one file and use it in another (as the tab sheet names are different). Unused sheets in each file are given a name of "zzassoc 1" and so on. We use a macro to extract the sheet and another to clear the contents as needed (and renames the tab back to the original "zzassoc 1" tab name. In addition, I also have a macro which sort the sheets alphabetically and another macro which sorts an overview tab that is linked to each individual tab.

Is there a known VBA script that I can use that will disregard the sheet names but will still allow me to implement the formula fixes I need without having to go into each file to fix them manually?
Viewing all 49825 articles
Browse latest View live