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

Sort sheets vba

April 8, 2020, 12:07 am
$
0
0
Hi,

I am seeking for help with regards to sorting sheet in ascending order (sheet 1 is before sheet 2 which is before sheet 3 and so on...) However, what I can find does not work after the workbook contains more than 9 sheets. For example, the code below will arrange sheet10 after sheet 1 and before sheet 2. Could you please advise me on this. Thank you

Code:
Sub SortSheetsTabName()
    Application.ScreenUpdating = False
    Dim iSheets%, i%, j%
    iSheets = Sheets.Count
    MsgBox iSheets
   
    For i = 1 To iSheets - 1
        For j = i + 1 To iSheets
            If Sheets(j).Name < Sheets(i).Name Then
                Sheets(j).Move before:=Sheets(i)
            End If
        Next j
    Next i
    Application.ScreenUpdating = True
End Sub
↧
Search

automatically moving rows

April 8, 2020, 12:54 am
$
0
0
Hey Team,

I am tracking all of the transactions that go through my company. I want to move the whole line when the purchased item is delivered to the customer. Attached is a very simplified version of my actual tracker, but the concept is the same. When a date is put into Column E, "Date Customer Received" on the "Current Orders" page, I want it to move automatically to the next available line on the "Completed Orders" page.

Full disclosure, I don't know VBA, but I know this is a VBA task. Im working on learning it, but please give me a fish now as I am learning to fish.

Thanks Team,

Respectfully,

-Phil
Attached Files
↧
↧

Macro to Expand/collapse on Date

April 8, 2020, 1:01 am
$
0
0
Hi,

I'm looking for some help with expanding my collapsed columns where a particular date is present.

I have 6 lots of grouped columns and want to only open the one where todays date is present. I'm using the following macro to go to the date

Code:
Sub Select_Today()
    Cells.Find(Date, , xlValues, xlWhole).Select

End Sub
if all my groups are closed then the above obviously doesn't work. I really want to modify the code to follow the following steps:

1) Collapse all groups (columns and rows)
2) follow the date code above but only opening the grouped columns where this date exists, not all of them

I'm familiar with VBA to do everything I have asked separately, I just cant seem to piece it together and only open the one I need.

Hope someone can help.

Thanks

K
↧

Macro's running slowly

April 8, 2020, 1:41 am
$
0
0
Hi,

For my job i have created an excel file with macro's that searches for keywords in texts and copies these data in a dataset to another sheet (in the same workbook). In the beginning it took only 3 seconds to run the macro's and get the data. Now it takes 20 seconds. I am already using the application screenupdating= false.

I really wonder why the time to execute the macro's increased to such an extent. I have since it was running slowly not added many macros but i have extended the worksheets with more formula's. Is there a way to reduce the macro running time?

Any input is much appreciated.
↧

Print journal autofilter between two dates

April 8, 2020, 1:41 am
$
0
0
Hi ...

Being new to VBA I struggle, but this one is beyond me ....

I have this sub which asks for a start and an end date.
So far so good.
But when it comes to autofilter it produces an error 1004: Application-defined og object-defined error.

I can't figure out what I am doing wrong. ... and I have googled, believe me.

Can any one help me out here?

- attached an example macro based spreadsheet.
Attached Images
Attached Files
↧
↧

[SOLVED] Macro to exit Macro is value = 0

April 8, 2020, 2:14 am
$
0
0
Where the value in D56 is = 0 (zero), then macro to exit sub, which is working


However if there is a zero beyond two decimal place eg 0.004, then macro must still exit

it would be appreciated if someone could amend must code accordingly



Code:
Sub Email_Report()
With Sheets("Variance BR1")
If .Range("D56").Value = 0 Then
Exit Sub
End If
End With
end sub
↧

E-mail selected cells/columns from excell workbook

April 8, 2020, 2:19 am
$
0
0
please can you assist me to send e-mail from Excel selecting specific location and columns
example in my attachment - need to select (filter) on Alrode from column A-E, row 2-24 and then send email to recipient I5 (or I can set the email address in the macro depending on your guidance)
similarly with the other facilities/locations - Filter Dumela, Durban etc.
thank you in advance

added smaller attachment
↧

DEBUG ERROR . not on every version

April 8, 2020, 2:21 am
↧
Search

Multiple filter buttons for collumns

April 8, 2020, 2:26 am
$
0
0
Good day experts.

I would like to ask for help with filter buttons for my excel file. Please see it attached:

Is it possible to create multiple filter buttons for column:

Buttons - Monotone/Rainbow/Paired/etc for column J
Buttons - Top Pair, 2nd pair/etc for column K
Buttons Open Ender/GutShot/etc for column L

But buttons should work together with others. (So I can active/deactivate multiple buttons)

For example I can click Monotone + Top pair + open ender (3 different columns)
Or I would like to check Paired + Flushdraws + overcard (2 filters from 1 column, 1 filter from third column)

Thank you in advance.

Best regards,

Swapijs.
Attached Files
↧
↧

VBA: Auto sum by cell colour in a row

April 8, 2020, 2:54 am
$
0
0
Hi

I'm trying to calculate totals in a row but want to split them out by cell colour (Green and Yellow) where any figures in yellow are totalled and any figures in Green are totalled seperately

Any assistance will be appreciated

Many thanks

Craig
↧

How to stop sub if Tab found with same name

April 8, 2020, 4:01 am
$
0
0
Hello all,

I have tried a few bits of code now to exit a sub which creates and names a new sheet if a sheet with the name already exists.

Ideally i'd like an info message to display alerting the user that their is an existing name and then for the operation to be aborted.

However I keep getting the sheet being named (2) instead which is not the desired result. Please see code below and attached example sheet.

If you click the button "Create focus list" then it will create a sheet from the template and name it based on whats in cell B6

Any ideas?

Code:
Private Sub CommandButton4_Click()

Dim a As String

Worksheets("Template").Range("E2").Value = Worksheets("PERFORMANCE HUB").Range("B6").Value

Worksheets("Template").Range("B64").Value = Worksheets("PERFORMANCE HUB").Range("AC6").Value
Worksheets("Template").Range("C64").Value = Worksheets("PERFORMANCE HUB").Range("B6").Value
Worksheets("Template").Range("D64").Value = Worksheets("PERFORMANCE HUB").Range("G6").Value
Worksheets("Template").Range("E64").Value = Worksheets("PERFORMANCE HUB").Range("O22").Value
Worksheets("Template").Range("F64").Value = Worksheets("PERFORMANCE HUB").Range("D38").Value
Worksheets("Template").Range("G64").Value = Worksheets("PERFORMANCE HUB").Range("R22").Value
Worksheets("Template").Range("H64").Value = Worksheets("PERFORMANCE HUB").Range("AH7").Value
Worksheets("Template").Range("I64").Value = Worksheets("PERFORMANCE HUB").Range("D32").Value
Worksheets("Template").Range("J64").Value = Worksheets("PERFORMANCE HUB").Range("D22").Value
Worksheets("Template").Range("K64").Value = Worksheets("PERFORMANCE HUB").Range("D24").Value
Worksheets("Template").Range("L64").Value = Worksheets("PERFORMANCE HUB").Range("D26").Value
Worksheets("Template").Range("M64").Value = Worksheets("PERFORMANCE HUB").Range("D28").Value
Worksheets("Template").Range("N64").Value = Worksheets("PERFORMANCE HUB").Range("D30").Value
Worksheets("Template").Range("O64").Value = Worksheets("PERFORMANCE HUB").Range("D34").Value
Worksheets("Template").Range("P64").Value = Worksheets("PERFORMANCE HUB").Range("Z6").Value
Worksheets("Template").Range("Q64").Value = Worksheets("PERFORMANCE HUB").Range("U22").Value
Worksheets("Template").Range("R64").Value = Worksheets("PERFORMANCE HUB").Range("I22").Value
Worksheets("Template").Range("S64").Value = Worksheets("PERFORMANCE HUB").Range("I24").Value
Worksheets("Template").Range("T64").Value = Worksheets("PERFORMANCE HUB").Range("I26").Value
Worksheets("Template").Range("U64").Value = Worksheets("PERFORMANCE HUB").Range("I28").Value
Worksheets("Template").Range("V64").Value = Worksheets("PERFORMANCE HUB").Range("I30").Value
Worksheets("Template").Range("W64").Value = Worksheets("PERFORMANCE HUB").Range("I32").Value
Worksheets("Template").Range("X64").Value = Worksheets("PERFORMANCE HUB").Range("I34").Value
Worksheets("Template").Range("Y64").Value = Worksheets("PERFORMANCE HUB").Range("W22").Value
Worksheets("Template").Range("Z64").Value = Worksheets("PERFORMANCE HUB").Range("AB6").Value


a = ActiveSheet.Cells(6, 2).Value
Application.DisplayAlerts = False
Sheets("Template").Copy After:=Sheets(Sheets.Count)

ActiveSheet.Name = a

With ActiveSheet
        .ListObjects(1).Name = a
    End With
↧

[SOLVED] Adding horizontal upper lower limit lines to existing chart

April 8, 2020, 4:10 am
$
0
0
Hi Guys

I suck at charts...

In attached sample...I am wanting to add labels at end of the lines "Upper" & "Lower"
Any ideas how to edit code to allow for this?

Code:
Sub AddLimitLines()
Dim RngArr, i As Long
With Sheet6
    RngArr = Array(.Range("N4:N8").Value, .Range("O4:O8").Value)
    For i = LBound(RngArr) To UBound(RngArr)
        With .ChartObjects("Chart 3").Chart.SeriesCollection.NewSeries
            .Name = ""
            .Values = RngArr(i)
            With .Format.Line
                .ForeColor.RGB = RGB(255, 0, 0)
                .Weight = 2
                .DashStyle = msoLineSysDash
            End With
        End With
    Next i
End With
End Sub
Attached Files
↧

How to switch a text to find to non-blank cells

April 8, 2020, 12:16 pm
$
0
0
Hello!

I'm trying to generate a list that is based on whether a column has anything written in its cells. Right now it find words with "for a selection" in it. I don't my code to look for any specific, only that there are words in the column selected.

For example, I want my code to look for the cells (NOT including the header) with words in it. It doesn't matter what the words are. Below is worksheet B.

pic3.png

Then goes to my Worksheet 'OUTPUT' below

pic4.png

Criteria:
1) Doesn't not my code for "for a selection" as you can see in the 2nd screenshot.
2) Doesn't include the headers from worksheet B or C or CC.


My code is as follows:
Code:
Option Explicit
Option Compare Text

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

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

'CODE ISSUE BELOW
For Each ws In ThisWorkbook.Sheets(Array("CC", "B", "C"))
'CODE ISSUE ABOVE
    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
   
    With ws
        LR = .Range("E" & .Rows.Count).End(xlUp).Row
        For Rw = 2 To LR
            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
Next ws

wsOUT.Columns.AutoFit
wsOUT.Activate
End Sub
Attached Files
↧
↧

Get user email address

April 8, 2020, 12:42 pm
$
0
0
Hi all,
I am trying to get the current user's email address. For the username is use Application.Username. I tried the following code which I found online but it keeps showing an error while opening the workbook (I added this code on a public function in a module which is called when workbook is opening.
Is there a simpler way to get that info?
Thank you

Code:
Public Function username()
username = Application.username
Dim OL As Object, olAllUsers As Object, oExchUser As Object, oentry As Object, myitem As Object
Dim User As String
Set OL = CreateObject("outlook.application")
Set olAllUsers = OL.Session.AddressLists.Item("All Users").AddressEntries
User = OL.Session.CurrentUser.Name
Set oentry = olAllUsers.Item(User)
Set oExchUser = oentry.GetExchangeUser()
Sheet2.Range("N2").Value = oExchUser.PrimarySmtpAddress
End Function
↧

If/Or and NULL logic

April 8, 2020, 12:59 pm
$
0
0
Hi,

I'm trying this but although it activates the Button it does not deactivate.

Why could this be?

Private Sub ComboBox1_Change()
If ComboBox1.Value = "United Kingdom" Or ComboBox1.Value = "United States" Then
CommandButton4.Enabled = True
End If
If ComboBox1.Value = Null Then
CommandButton4.Enabled = False
End If
End Sub
↧
Search

Trouble with If ElseIf Else statements

April 8, 2020, 1:24 pm
$
0
0
The sample workbook is still a mess but I'm going through it error by error and a quick step in will take you to my current problem. I can't seem to get the syntax quite right.

Suggestions would be helpful even if the suggestion is a reference link to learn the proper syntax. I think I may be confusing VBA with VB (which I used quite a while back).

Thanks
Attached Files
↧

Drop Down List Color Selector - NOT Conditional Formatting

April 8, 2020, 2:21 pm
$
0
0
Is it possible to have a drop down menu show colors within the drop down menu itself? I don't want to be able to select "Red" and after selecting that value, the cell turns red. I want the ability to see the color red in the drop down menu. Is this possible?
↧
↧

creating an offset based on a range variable

April 8, 2020, 2:24 pm
$
0
0
Hello, I created a range variable for later use, so I can take advantage of the inbuilt .OFFSET function. However, after utilizing the

However, it keeps getting stuck in the line 'Sheets("Temp").pasteRange.Offset(, 1).Formula = 2". The error "Object doesn't support this property or method." How would I go about fixing it to make it work as intended?

Code:
Sub Macro2()
    Dim pasteRow As Long, pasteColumn As String
    Dim pasteRange As Range, newRange As Range, newRange2 As Range
    pasteRow = 3 'row to be pasted
    pasteColumn = "C" 'column to be pasted
   
    Set pasteRange = Range(pasteColumn & pasteRow)
    pasteRange.Formula = 1
    Sheets("Temp").pasteRange.Offset(, 1).Formula = 2 'doesn't work
    Sheets("Temp").pasteRange.Offset(, -1).Formula = 0 'doesn't work
    pasteRange.Offset(, 1).Formula = 2 'works
    pasteRange.Offset(, -1).Formula = 0 'works
       
End Sub
Thank you for your help
↧

Copying data to another sheet in order to make a pivot table

April 8, 2020, 2:33 pm
$
0
0
Hi,
I'm looking for a more automated way to copy data from one sheet into another sheet, so that I can use the reformatted data to make a pivot table. I am certain there must be a Macro that can do this for me, but I have zero experience programming that and would not know where to start. I will follow whatever directions you give me, though!

I am attaching a sample workbook. In the "Raw" tab, is where I enter the results from some peer reviews (you could think of it like a survey). I have been manually copying and pasting it to the "Reformat" tab, so that I can use it in the Pivot Table. I reformatted the first two lines from the Raw Tab so you can see what I am talking about.

Is there a way to automate this reformatting?
Attached Files
↧

Excel to Outlook VBA, deselect Cells?

April 8, 2020, 3:07 pm
$
0
0
I have the following code which sends the contents of rows as an email.
However once the email is sent the cells stay selected.
Can anyone help to clear the selection? I have attached an example sheet as well

Code:
Option Explicit
Public Sub Emailtest()
' add ref - tool -> references - > Microsoft Outlook XX.X Object Library
    Dim olApp As Outlook.Application
    Set olApp = New Outlook.Application

    Dim Email As Outlook.MailItem
    Set Email = olApp.CreateItem(0)

' add ref - tool -> references - > Microsoft Word XX.X Object Library
    Dim wdDoc As Word.Document '<=========
    Set wdDoc = Email.GetInspector.WordEditor

    Dim Sht As Excel.Worksheet
    Set Sht = ThisWorkbook.Worksheets("Sheet1")

    Dim rng As Range
    Set rng = Sht.Range("G2:G6").SpecialCells(xlCellTypeVisible)
        rng.Copy

    With Email
        .To = Sht.Range("B1")
        .CC = Sht.Range("B1")
        .Subject = Sht.Range("G2")
        .Display

        wdDoc.Range.PasteAndFormat Type:=wdFormatOriginalFormatting
    End With
End Sub
Attached Files
↧
Viewing all 49820 articles
Browse latest View live
Search