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

Click a shape to toggle black fill and change line color to black

March 22, 2020, 10:29 pm
$
0
0
Hello,
I need some help on this VBA.

I need two macros, one has no linked cells, other has linked cells.

Click a shape to toggle black fill and change line color to black. Change linked cell from FALSE to TRUE
Click again, the shape will change back to white fill and line color to R: 240, G: 171, B: 165. Linked cell changes to "FALSE"

There are many tooglebutton oval shapes.

In Shape 1, right click and select "assign marco",select 'Filled oval slots.xlsm'!RoundedRectangle1_Click
Then click "OK". If I click Shape 1, it gives an error that "cannot run the marco ….."


Code:

Option Explicit

Sub ToggleButton(Optional Dummay As Long)

    Dim oBtn As Shape
    Dim oShape As Shape
   
    Set oBtn = Worksheets("Sheet1").Shapes(Application.Caller)
   
    'If oBtn.Fill.ForeColor.RGB = RGB(0, 0, 0) Then
        'oBtn.Fill.ForeColor.RGB = RGB(255, 255, 255)
        'oBtn.Line.ForeColor.RGB = RGB(249, 171, 165)
      ' Exit Sub
  ' End If
   
    For Each oShape In Worksheets("Sheet1").Shapes
        'If oShape.Title = oBtn.Title Then
                    If oShape Is oBtn Then
                With oShape
                    .Fill.ForeColor.RGB = RGB(0, 0, 0)
                    .Line.ForeColor.RGB = RGB(0, 0, 0)
                End With
            Else
                With oShape
                    .Fill.ForeColor.RGB = RGB(255, 255, 255)
                    .Line.ForeColor.RGB = RGB(249, 171, 165)
                End With
            End If
        'End If
    Next oShape
   
End Sub
Thanks
Attached Files
↧
Search

Hiding buttons on new sheet creation

March 23, 2020, 12:52 am
$
0
0
Hi all

i have three buttons on my workbook (on the "MASTER MASTER" sheet) "New Sheet" (which asks you what name you want the sheet call and then creates the sheet), also "Save" and "Clear Sheet".

what id like to happen is, when using the "New Sheet" button, i'd like to code to run but id like to add a hide function for the newly created sheet where the "New Sheet" & "Clear Sheet" buttons are hidden on the newly created sheet.

file attached
↧
↧

[SOLVED] "Can't find Project or Library" error

March 23, 2020, 1:45 pm
$
0
0
This hasn't happened in over a year, but I've got a workbook I update every day that just today started displaying a "Can't find Project or Library" error. When I open it the VBA project is blank, the References won't appear, and I can't export any modules (gives me "Module Not Found"). I can't attach the file because it's too large, and I can't trim it down to make it smaller because it won't let me save it. Help! What can I do?

What I've tried is opening Excel in Safe Mode; I still get the same errors.
↧

Find max and minimum values in a section of a column, then do the same in next section.

March 23, 2020, 3:50 pm
$
0
0
I currently have a long list of time stamps in one column that looks like this:[ATTACH]668722

The column is divided in sections of varying length divided by a space.

I am trying to write a program that finds the min and the max (the earliest and latest time) value in each section and then copies those values to another column before moving on to the next section.

Any ideas and help would be appreciated.

A portion of the column is attached.
Attached Images
Attached Files
↧

Excel Macro not working with Excel Version 1911

March 23, 2020, 3:53 pm
$
0
0
Hello,

I am pretty new to VBA Coding and and i have managed to make a Macro that works perfectly on my computer. (I have Excel version 1902.) When i sent the spreadsheet to others who have version 1902 it works perfectly. However, it has not been working for one user. The only difference with this person is he has Excel Version 1911. I can't imagine thats the only reason it doesn't work, but can someone help me out?

I am new to the forum as well.

This is in SHEET 1 not a module
Code:
Sub Mail_Selection_Range_Outlook_Body()
   
 If ActiveSheet.Range("C3").Value = "" Or ActiveSheet.Range("C5").Value = "" Or ActiveSheet.Range("C7").Value = "" Or ActiveSheet.Range("C9").Value = "" Or ActiveSheet.Range("C11").Value = "" Or ActiveSheet.Range("C13").Value = "" Or ActiveSheet.Range("C15").Value = "" Then
 
    MsgBox "Missing Field Entry"
    Exit Sub
    End If
   
    ws_output = "Sheet2"

next_row = Sheets(ws_output).Range("A" & Rows.Count).End(xlUp).Offset(1).Row

Sheets(ws_output).Cells(next_row, 1).Value = Range("Name").Value
Sheets(ws_output).Cells(next_row, 2).Value = Range("Mainline").Value
Sheets(ws_output).Cells(next_row, 3).Value = Range("Lane").Value
Sheets(ws_output).Cells(next_row, 4).Value = Range("Equip").Value
Sheets(ws_output).Cells(next_row, 5).Value = Range("Date").Value
Sheets(ws_output).Cells(next_row, 6).Value = Range("Time").Value
Sheets(ws_output).Cells(next_row, 7).Value = Range("Issue").Value
   
   

    Dim rng As Range
    Dim OutApp As Object
    Dim OutMail As Object

    Set rng = Nothing
    On Error Resume Next
    Set rng = Sheets("Sheet1").Range("b2:c16")
    On Error GoTo 0

   

    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With

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

    On Error Resume Next
    With OutMail
        .To = ""
        .CC = ""
        .BCC = ""
        .Subject = "Issues"
        .HTMLBody = RangetoHTML(rng)
        .Display  'or use .send
    End With
    On Error GoTo 0

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

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub
Code:
Function RangetoHTML(rng As Range)
' Changed by Ron de Bruin 28-Oct-2006
' Working in Office 2000-2016
    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook
   
   
    TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"

   
    rng.Copy
    Set TempWB = Workbooks.Add(1)
    With TempWB.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial xlPasteValues, , False, False
        .Cells(1).PasteSpecial xlPasteFormats, , False, False
        .Cells(1).Select
        Application.CutCopyMode = False
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
    End With

 
    With TempWB.PublishObjects.Add( _
        SourceType:=xlSourceRange, _
        Filename:=TempFile, _
        Sheet:=TempWB.Sheets(1).Name, _
        Source:=TempWB.Sheets(1).UsedRange.Address, _
        HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With

    'Read all data from the htm file into RangetoHTML
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
    RangetoHTML = ts.readall
    ts.Close
    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                          "align=left x:publishsource=")

    'Close TempWB
    TempWB.Close savechanges:=False

    'Delete the htm file we used in this function
    Kill TempFile

    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function



This is also in the VBA but its in its own module:


Code:
Sub Input_Date()

Range("c11").Value = Date

Sheet1.Unprotect Password:=secret"

      Range("c13").Value = Time
        Range("c13").NumberFormat = "h:mm:ss AM/PM"

    Sheet1.Protect Password:="secret"

 
   
       
End Sub
↧
↧

[VBA] Copying data from Excel to .txt File

March 23, 2020, 4:29 pm
$
0
0
Hello

I am trying to make VBA to copy data from Excel to .txt file.
The problem is that I am not quite sure of 2 things

1) How to define the range so that VBA should know to take a specific range for each Car make (for the first Car make the range was initiated manually). So I think the condition would be something like: If(Car make==same as Car make from rows below), then do a minimum on Mileage for that range, and this should be done for each Car make.
.
2) How to make the code more efficient rather than declaring a lot of variables. As there would be hundreds of entries (multiple Car makes, and after each make the lowest Mileage should be displayed). As what has been done so far for rows 2-3 should also be done for rows 4-7, and so on... But for the sake of the example I kept it short.


Below you'll find attached the Workbook (the code is located in Module1), as well as the expected Answers in the .txt file.

I would be more than grateful if someone could help me out with it.

Many thanks, I appreciate it!

Gordon
Attached Files
↧

Opening a workbook, copy and pasting to a different workbook

March 23, 2020, 5:00 pm
$
0
0
Hi all,

Would somebody please be kind enough to help me with a problem I have. To confirm I am a VBA novice at best.

I've managed to put together a code following various youtube tutorials where a macro opens the most recent saved file in a specific folder. I'm now stuck on the next part of the code where I would like to copy the data from this open workbook into the book where the macro sits, and then to close the open workbook.

A possible complication is that the file being opened with the first part of the macro does not have a static filename (A new version is saved daily), hence why I've coded for the most recently saved version rather than a static file name.

The code I've put together so far is below if it helps...
Code:
Sub recentFileSpecificFolder()
Dim myFile As String, myRecentFile As String, myMostRecentFile As String
Dim recentDate As Date
Dim myDirectory As String
myDirectory = "\\my file path is here\"
Dim fileExtension As String
fileExtension = "*.xls"

If Right(myDirectory, 1) <> "\" Then myDirectory = myDirectory & "\"

myFile = Dir(myDirectory & fileExtension)

If myFile <> "" Then
    myRecentFile = myFile
    recentDate = FileDateTime(myDirectory & myFile)
Do While myFile <> ""
    If FileDateTime(myDirectory & myFile) > recentDate Then
        myRecentFile = myFile
        recentDate = FileDateTime(myDirectory & myFile)
    End If
    myFile = Dir
Loop
End If
myMostRecentFile = myRecentFile
Workbooks.Open Filename:=myDirectory & myMostRecentFile

End Sub
↧

How to name the row of the most recently selected cell

March 23, 2020, 5:27 pm
$
0
0
The goal here is to link TxtBx_Rows with the row in which a cell is selected, and then when focus is shifted to the Userform, shift the selection to Column B of that row. This code seemed reasonable to me. but it doesn't work because it depends on the cell being active, and once the Userform is activated, the cell no longer is.(At least I think that's why it doesn't work)
Code:
Private Sub UserForm_Activate()                             
    Dim r As Long
    r = ActiveCell.Row
                                                              ' doesn't work because as soon as UF_C
    UF_Categories.TxtBx_Rows = r                              ' is activated, r is no longer active
    UF_Categories.SpinButton1 = r                              ' like ships passing in the night
      Range("B" & r).Select

End Sub
Is there another way to define r in this sub that will accomplish this seemingly simple goal?

Thanks!
↧
Search

Workbook missing

March 23, 2020, 6:02 pm
$
0
0
Hello,
I lost my workbook :o(

I have a original workbook. When I open the original workbook and I click "File" then "Save as" and I gave it a new name.
Then I started working on a new file name on the workbook and when I finished, I remembered I save the new workbook.
But when I to look the new workbook, it's not in my document. When I click "file" and I do see it in the current open/save file and I when I click that it said:

"Sorry, we couldn't find C:\Users/NAME\Documents\032320FILE.xlsm. Is it possible it was moved, renamed or deleted?"

So I keep wondering what is going on so I thought if I rename the original workbook then I may be able to use. So I went to Documents Library and I right click the original workbook and gave it a new name, then the workbook disappeared from the library.
I don't know where the original went. It just disappeared. I check the trash but it was not there.


Do you know what is going on? How do I retrieve or find the original document?

Please help! :o(

Thank you
↧
↧

vba code to find the last visible row when there are hidden rows below

March 23, 2020, 6:04 pm
$
0
0
I tried searching for the answer to this but haven't seen any. And I made several attempts to solve for this using CurentRegion but nothing is working.

I have a worksheet that contains a visible block of data from row 3 to the last row (which could be row 37 or any other amount of rows).

Below that block of data would be another small block of data that is hidden.


I'm looking for a code that will find the last visible row in column A while ignoring the lower block of data.

if the last row in the upper visible block of data is 52, I need a code that would find 52 as the last row.

Can someone help?

Thank you.
↧

Add Windows User Name to Cell

March 23, 2020, 7:04 pm
$
0
0
Experts:

Attached is a sample spreadsheets which includes a validation process checking whether or not all five (5) questions have been answered (prior to closing XLS).

As part of the XLS closing process, the validation throws a message including the user's name plus the questions which are still unanswered.

Here's what I need some help with:
- Upon opening the spreadsheet, I want the Windows username (see validation message) automatically added into cell F1 (independent from having answered the questions). What VBA needs to be added which will insert the value? Once that's working column F will be hidden (merely for tracking who submitted what information).

Thank you,
EEH
Attached Files
↧

Help VBA insert text cell for multiple file!!!

March 23, 2020, 7:10 pm
$
0
0
Hi all,

First time to the board, help me!!!
In this case only a file. If multiple file excel (file1.xls, file2.xls,...filen.xls) i want insert text cell C1 with text: List
Code:
Sub AddText()
For Each cell In Range("B2:E9")
cell.Value = "Score: " & cell.Value
Next
End Sub
↧

macro to split data in text file

March 23, 2020, 8:10 pm
$
0
0
Hi All,

Can anyone help me on this problem?
I have 100k++ data which is in text file. But I need to separate them and formula is not doing any good as the number lengths are not the same.
the key identifier is the | that separates the number.

Hope someone can help me.

sample:
Attached Files
↧
↧

Help looping through a column and replacing values

March 23, 2020, 9:13 pm
$
0
0
I have the following macro

Code:
Sub Test2()
LastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row
Dim rng As Range: Set rng = Range("A2:A" & LastRow)
Dim i As Integer
For i = 2 To rng.Rows.Count
 

  If Not Cells(i, 1).Value = "Spanish Translation" Or Cells(i, 1).Value = "Sales" Or Cells(i, 1).Value = "Customer Service" Or Cells(i, 1).Value Like "*Claims*" Or Cells(i, 1).Value = "-" Then
      Name = Cells(i, 1).Value
      Range("A" & i + 1).Value = Name
      i = i + 1
  End If

Next i

End Sub
Basically what I want to do is replace the name of the cell that is not any of the following (Claims Customer Service,Claims Team 22,Claims Supervisor Team 22,Customer Service,Sales,Spanish Translation,-) and replace it with the cells in blue ( a name) so that I can have a column with the names in replace of the any of these values (Claims Customer Service,Claims Team 22,Claims Supervisor Team 22,Customer Service,Sales,Spanish Translation,-)

the image below is the column that i have and the output that i want.

2020-03-23 22_09_33-Book1 - Excel.png

Can it be done
↧

Transfer selective cells value in a flagged row to new sheet Respectively

March 23, 2020, 11:31 pm
$
0
0
Hi
am facing an issue which need an expert to solve, I have this workbook which contains two sheets (Registration & Refunds)
now in sheet 1 (Registration) I keep register each new card dispute I received & there is a flag column.

If the flag column has the value "R" then I want selective cells in same row to be transferred to sheet 2 (Refunds)

The real challenge is, Registration sheet will keep increase in the rows so if for example row number 2 and row number 7 are flagged with "R" the challenge is to make them appear in Refunds sheet in sequent rows 1 & 2 without empty rows in between. (Below each other)

Sheet 1 (Registration):
if column K has the value "R" then transfer the value in cells (Account, Amount, description 1 & 2) to sheet 2 (Refunds)

Sheet 1.jpg

Sheet 2 (Refunds):
The requested cells are transferred but in same row number of sheet 1, the challenge is instead of the values be in row 11 in Refunds sheet to be in row 3 direct under the first row

sheet 2.jpg

and her I attache a sample excel with comments inside
Attached Files
↧
Search

Add Data validation of Alphabetically Sort Unique values using Array Formula

March 23, 2020, 11:43 pm
$
0
0
Hello Excel Experts,
First of all, i thank each member for their suggestion to figure out issue in below post. Currently i am too struggling with same issue and after going through below post i found the issue was with drop downs..!!
https://www.excelforum.com/excel-pro...ver-as-mu.html

Below is the code which i currently use to get sorted unique values and its definitely causing the error. How can i create drop downs (Unique and Sorted) using Array formulas and in-turn add into VBA..? Sorry i am not that used to Array formulas..:( Please help.. By the way i have 5000 rows (dynamic) of data and unique values among them may be 50 or so..

Code:
Function Sorted(Rng As Range, Optional Delim As String = ",") As String
  Dim X As Long, Arr As Variant, Uniques As Variant
  Arr = Rng.Value
        With CreateObject("Scripting.Dictionary")
          For X = 1 To UBound(Arr)
            .Item(Arr(X, 1)) = 1
          Next
          Uniques = .Keys
        End With
        With CreateObject("System.Collections.ArrayList")
          For X = LBound(Uniques) To UBound(Uniques)
            .Add Uniques(X)
          Next
          .Sort
          Sorted = Join(.ToArray, Delim)
          If left(Sorted, 1) = Delim Then Sorted = Mid(Sorted, 2)
        End With
End Function

Sub allDropDowns()
 Dim unique_string1 As String

 Worksheets("SOMENAME").Select
 On Error Resume Next
    Worksheets("SOMENAME").ShowAllData
  On Error GoTo 0
    unique_string1 = Sorted(Worksheets("SOMENAME").Range("A4", Worksheets("SOMENAME").Cells(Rows.Count, "A").End(xlUp)))

 With Worksheets("Macro").Range("C9").Validation
        .Delete
        .Add xlValidateList, Formula1:="All," & unique_string1
 End With
↧

VBA Code to print datas in a selected row/colummn

March 24, 2020, 1:09 am
$
0
0
I have created a data base using userform and used following codes to enter dataas on it.

Private Sub CommandButton1_Click()
Dim i As Integer
i = 1
While ThisWorkbook.Worksheets("Sheet1").Range("A" & i).Value <> ""
i = i + 1
Wend
ThisWorkbook.Worksheets("Sheet1").Range("A" & i).Value = TextBox1.Value
ThisWorkbook.Worksheets("Sheet1").Range("B" & i).Value = TextBox2.Value
ThisWorkbook.Worksheets("Sheet1").Range("C" & i).Value = TextBox3.Value
ThisWorkbook.Worksheets("Sheet1").Range("D" & i).Value = TextBox4.Value
Unload Me
If TextBox1 = "" Then
MsgBox "Please enter your name"
Unload Me
End If
End Sub

Private Sub TextBox1_Change()

End Sub

Private Sub UserForm_Click()

End Sub

Now I Want to Print datas of every row on selecting each row by name. What code has to be used for the purport.please help
↧
↧

Issue when Copying Worksheet Says "" already exists?

March 24, 2020, 10:25 am
$
0
0
I have an issue whereby I click a button to generate a new worksheet. It used to work fine but now after I have altered the template which I copy from it keeps coming up with messages saying that the name A9999999999999 already exists and then a few others before eventually doing what I've asked it to.

Is there any way I can get rid of these annoying messages?

Please see worksheet attached. Click on create focus list button to generate the sheet and see the problem.

Regards

Kev W
Attached Files
↧

Save document as PDF macro

March 24, 2020, 10:33 am
$
0
0
Hi I have the following code,

I am trying to save the print area of only one page of my workbook, as a pdf with the file name as K3 & save it in a specified folder, It just isnt working as it's saving it as a excel macro enabled workbook. Can anyone help?

Code:
Sub SAVEPDF()
'
' SAVEPDF Macro
'
   
    Dim FName          As String
    Dim FPath          As String
    Dim username As String
    username = Environ$("username")
   
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF
    FPath = "C:\Users\" & username & "\Dropbox\Quotations To Be Emailed"
    FName = ActiveWorkbook.ActiveSheet.Range("k3").Text
    ThisWorkbook.SaveAs Filename:=FPath & "\" & FName
   
End Sub
↧

Auto Fit Row Height VBA Code

March 24, 2020, 10:53 am
$
0
0
Hello All,

I'm trying to write a code that will autofit row height when cell has data . Attached you will find my workbook any ideas or suggestions would be greatly appreciated.

Code:
Sub FitRow_Height()
'
' FitRow_Height Macro
'

'
    Rows("65:65").RowHeight = 27.5
    Rows("65:65").RowHeight = 37.5
    Rows("66:66").RowHeight = 32.5
    Rows("66:66").RowHeight = 40
    Rows("67:67").RowHeight = 25.5
    Rows("68:68").RowHeight = 34
    Rows("69:69").RowHeight = 26.5
End Sub
Attached Files
↧
Viewing all 50158 articles
Browse latest View live
Search