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

decuct a constans value from time

$
0
0
Could anybody help me, how can I deduct a given value deduct from a time-value?
Let's say I would like to know how much is 12:00-2 hours or 12:00-120 minutes?

I know the datediff-function but it the 2nd parameter wouldn't be a date-value but a concrete number.
Thanks

[SOLVED] Worksheet_Change - Cell States (Numeric, Chars, Blank) not hitting conditions?

$
0
0
Hello (First Post - Go Easy!)

Having an issue with a Worksheet_Change Event where I'm trying to distinguish what type of action a user has performed within a Column Cell Range. I need to work out if the user has entered a numeric value, characters or whether they have deleted the cell. I cannot work out why with my current solution I can hit the first and last condition but not the second?

I've tried multiple variants of the second condition using solutions like cell value = "", cell value = vbNullString and a few others.

Code:

Public Sub Worksheet_Change(ByVal Target As Range)

    Set column1 = Intersect(Target, Range("A8:A32"))
    Set column2 = Intersect(Target, Range("K8:K32"))
    Set column3 = Intersect(Target, Range("L8:L32"))
    Set column4 = Intersect(Target, Range("V8:V32"))
   
    cellRef = Target.Address(0, 0)
   
    'Finds Next Empty Row
    rowRef = Worksheets("COINS Body").Range("D" & Rows.Count).End(xlUp).Row + 1
   
    If Not column1 Is Nothing Then
        cellDescrip = Range("D" & Range(Target.Address(0, 0)).Row).Value
        If IsNumeric(Target.Value) Then
            Debug.Print "VALUE ENTERED"
        ElseIf IsEmpty(Target.Address(0, 0)) Then
            Debug.Print "DELETED CELL"
        Else
            Debug.Print "CHARS ENTERED"
        End If
       
    Else
    End If
End Sub

Cheers!
Attached Files

Creating new sheets with names from a range of cells with values eliminating the blanks.

$
0
0
I am trying to create new sheets (with names) from values in a range of cells say A1:AZ30 some of which at some point have blanks. The code below can create the new sheets with names (of values in cells) but when the program find a blank it out puts and error and stops. it also creates an unnamed sheet. How do i avoid that? i want it to be able to skip the blanks and continue with the rest of the cells with values.

Code:

Sub Auto_Open()

    Sheets("NewSheets").Select
    Range("A1:AZ1").Select

End Sub

Code:

Sub CreateSheetsFromAList()
Dim MyCell As Range, MyRange As Range

Set MyRange = Sheets("NewSheets").Range("A2:AZ2")
Set MyRange = Range(MyRange, MyRange.End(xlDown))

For Each MyCell In MyRange
Sheets.Add After:=Sheets(Sheets.Count) 'creates a new worksheet
Sheets(Sheets.Count).Name = MyCell.Value ' renames the new worksheet
Next MyCell

Sheets("NewSheets").Select
Range("A1").Select

End Sub

Kindly help me improve this or give me a better option.

Also want to be able to automatically add a template/table to every newly created sheet.

Thank you.

Colin

find and copy cell value if condition met and group them in the range

$
0
0
Hi All, I would like to prepare calculation for my team. Column A - name, Column B - start time, Column C - end time. I need find all of the colleagues who has more than the allowance for start time. My allowance is 40mins for the start time. I need select all of the colleagues who has more than 40 mins in column B and than group them in the range 1st group 0, 2nd 1-5mins, 3rd 6-10mins, 4th 11-15mins, 5th 16-20mins, 6th 21-25mins, 7th 26-30mins, 8th 31-35mins, 9th 36-40mins, 10th 41-45mins, 11th 46-50mins, 12th 51-55 mins, 13th more than 56mins. I need prepare same calculation for end time column C like for start time but my allowance is 45mins. Range it is same like for start time. Can anybody help me to prepare code in vba?
Attached Files

sheet tab color change

$
0
0
Hi , i would lie to change a sheet color - tried to use this code

Private Sub Worksheet_Change(ByVal Target As Range)
'Updateby Extendoffice 20160930
If Target.Address = "$C$11" Then
Select Case Target.Value
Case "2016"
Me.Tab.Color = vbWhite
Case "2017"
Me.Tab.Color = vbYellow
Case "2018"
Me.Tab.Color = vbRed
Case "2019"
Me.Tab.Color = vbGreen
Case "2020"
Me.Tab.Color = vbBlue
Case Else



but it works only if I manually write down a value (e.g. 2017 etc.). But my intention is to change color based on the value copied from another sheet , in this case it is ='Sumár úľov'!F11 - but it does not work. Any suggestion would be welcome

Excel vba coding

$
0
0
Hi there I have a problem with vba coding for searching in excel worksheet. My actual code works fine but it searches data from the begining of work sheet rows/cell to the end of work sheet rows/cell. I need to code that it start search from the last row entry to the top of the work sheet. Any help how to modify my code to perform the search from last entry please? this is my actual code:

Code:

Dim totRows As Long, i As Long

totRows = Worksheets("sheet1").Range("A1").CurrentRegion.Rows.Count

 If TextBox1.Text = "" Then
  MsgBox "Enter the File Number"
  End If
 
For i = 2 To totRows
        If Trim(Sheet1.Cells(i, 1) <> Trim(TextBox1.Text)) And i = totRows Then
          MsgBox "File Not Found!"
          End If

thanks

         
        If Trim(Sheet1.Cells(i, 1) = Trim(TextBox1.Text)) Then
          TextBox1.Text = Sheet1.Cells(i, 1)
          TextBox2.Text = Sheet1.Cells(i, 2)
          ComboBox1.SelText = Sheet1.Cells(i, 3)
          TextBox3.Text = Sheet1.Cells(i, 4)
          TextBox6.Text = Sheet1.Cells(i, 5)
          ComboBox3.SelText = Sheet1.Cells(i, 6)
          ComboBox2.SelText = Sheet1.Cells(i, 7)
          Exit For
      End If
Next i
   
   
End Sub

Copying a workbook but keep formula results not formula?

$
0
0
Code:

Sub Createandsavejobsht()
    Dim Rng                    As Range
    Dim Path As String
    Dim filename As String

    Set Rng = Range("Y1:AN38")
    Path = "C:\Users\chris\Dropbox\MTRDCS"
    filename = Range("Y2")
   
    Application.Workbooks.Add
    Rng.Copy Destination:=ActiveSheet.Range("Y2")
    ActiveWorkbook.SaveAs filename:=Path & "\" & filename & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled
End Sub

I am using this to save a particular range of my excel work book & save it in a set location with a set filename. When I use this I get the following error come up in the new workbook=#REF!

I have lots of formulas on the original workbook & I would like to keep only the result of the formula, is this possible?

How can I determine the index of a Point object within it's parent array?

$
0
0
Consider the code below (so simple as to be self-explanatory). The print statement never gets called, despite the outer conditional evaluating to TRUE, which seems odd to me. Any ideas why?

Code:

If TypeOf ActiveSheet Is Chart And TypeName(Selection) = "Point" Then
            Dim pnt0 As Point
            Set pnt0 = Selection
           
            Dim ser As Series
            Set ser = pnt0.Parent
           
            Dim pnt As Point

            Debug.Print "Looking now" 'This is reached.
           
            i = 0
            For Each pnt In ser.Points
                i = i + 1
               
                If pnt Is pnt0 Then
                    Debug.Print "got it! " & i 'This is never reached.
                End If
            Next pnt
    End If


Return paragraph number based on found text

$
0
0
Hello,

I'm trying to write a portion of code that will find specific text in a Word document and return the paragraph number(s), where the text occurs. I thought the code below would suffice, but the code "aRng.Paragraphs.Count" simply returns "1" each time "QUESTION" is found. Any advice would be greatly appreciated!

Code:

Sub extractMain()

Dim wdApp As Object
Dim wdDoc As Object
Dim aRng As Object

Set wdApp = CreateObject("Word.Application")
wdApp.Visible = False

strfile = "C:\Users\roy\test_docs\test1.docx"

Set wdDoc = wdApp.Documents.Open(Filename:=strfile, AddToRecentFiles:=False, Visible:=False)

Set aRng = wdDoc.Range

With aRng.Find
    .ClearFormatting
    .Text = "QUESTION"
    .MatchWildcards = True
   
    Do While .Execute  ' Loop until Word can no longer find the search string
       
        MsgBox aRng.Paragraphs.Count
   
    Loop
End With

wdDoc.Close False
Set aRng = Nothing
Set wdDoc = Nothing
wdApp.Quit
Set wdApp = Nothing

End Sub

Thanks,
Roy

Lock unlock cell depending condition

$
0
0
Good afternoon;

I need the help of somebody.

I need one code to lock some especific range of cells depending of the value of other cell in the same row.

If the value of the cell X in the column F is null or empty, the ranges AGX:AIX; AKX:AMX; CDX:CFX; CHX:CJX is locked, if not is not unlocked.

The code used is:

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
    ActiveSheet.Unprotect
    ' assming status is in column 6("F")
    Dim cl As Range
    Dim RangeGr, RangeRL, RangeExtRL, RangeRLH, RangeRT, RangeBlancura, RangeHF As Range
    Dim MultipleRange As Range
    If Target.Column = 6 Then
        For Each cl In Target.Cells
            Set RangeGr = Range("AG" & cl.Row & ":AI" & cl.Row, "AK" & cl.Row & ":AM" & cl.Row)
            Set RangeRL = Range("CD" & cl.Row & ":CF" & cl.Row, "CH" & cl.Row & ":CJ" & cl.Row)
            Set RangeExtRL = Range("CO" & cl.Row & ":CQ" & cl.Row, "CS" & cl.Row & ":CU" & cl.Row)
            Set RangeRLH = Range("CZ" & cl.Row & ":DB" & cl.Row, "DD" & cl.Row & ":DE" & cl.Row)
            Set RangeRT = Range("DH" & cl.Row & ":DJ" & cl.Row, "DL" & cl.Row)
            Set RangeBlancura = Range("DO" & cl.Row & ":DQ" & cl.Row, "DS" & cl.Row & ":DU" & cl.Row)
            Set RangeHF = Range("EX" & cl.Row & ":FC" & cl.Row)
            Set MultipleRange = Union(RangeGr, RangeRL, RangeExtRL, RangeRLH, RangeRT, RangeBlancura, RangeHF)
            If UCase(cl.Value) = "Yes" Then
                MultipleRange.Locked = True
            Else
              MultipleRange.Locked = False
            End If
        Next
    End If
    ActiveSheet.Protect
End Sub

But dont lock and unlock nothing.

Could somebody to help me?

Is it possible no to use "Worksheet_Change" in order that allways works without changing nothing in the worksheet?

Thanks in advance.

[SOLVED] Using a Date when Saving a file using VBA

$
0
0
Good afternoon all,

I have a spreadsheet, where I would like the code to automatically use 2 fields to create the file name for saving the file to a SharePoint site.
The code I have is as follows:

Code:

Sub Post_Req()
' To save document to SharePoint, using the file name and Submit date fields to create save file.

Dim SubDte, Title, FileName, FolderName, FullFileName

Application.DisplayAlerts = False

SubDte = Worksheets("Request Form").Range("G6").Value
Title = Worksheets("Request Form").Range("I6").Value
FileName = Title & "-" ' & SubDte
' Location for Requests to be saved to
FolderName = "C:\Users\xxxxxxx\Desktop\FLS\Projects\SharePoint Workflows\Rework\"  ' Test location
' FolderName = "http://xx.xxxx.xxx.com/xxx/xxxx/xxx/Rework/" ' Live location

FullFileName = FolderName & FileName
    ActiveWorkbook.SaveAs FileName:=FullFileName, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=True
       
MsgBox "Request posted, document name " & FileName & ".xlsm" & vbCrLf & vbCrLf & "" & vbCrLf & "Approval Workflow now started in SharePoint"

Application.DisplayAlerts = True
     
' ThisWorkbook.Close (False)

End Sub

Cell G6 is a Date field and usually would be in dd/mm/yyyy format but I am aware that ' / ' are not allowed when saving a file in Excel. I then tried to use a custom format dd-mm-yyyy in the cell but VBA is still recognising this as a Date format and fails.
If I remove the requirement for SubDte to be used in the file name, it saves perfectly to my test environment. (e.g. FileName = Title & "-" ' & SubDte)

Ultimately, my goal is to create the file name based on 2 fields - one being a text string and the other being the submit date of the request.
Any help in correcting my code to achieve this is very much appreciated.

Thank you,
Chris

Copy range from multiple sheets with same name in files in same folder to single sheet

$
0
0
Hi all,

I have problem with a VBA code. I bet it’s a stupid mistake I’m doing but cannot figure it out.
I have folder with many excel files (Document Folder). In each of the excel files I have sheets, and one of them is named “Orders”.
I need to copy the values (e.g. range A1:X100) from the sheet “Orders” from all of the excel files in a single “MasterData” sheet.
In the column “A” of the “MasterData” sheet I need to have the excel file name.
In columns C and further right I need to have the data from sheet “Orders”, ideally just a text values (I don’t need to see the formulas in the copied cells, rather the result). It will be really great if I could have also the formatting for the copied cells.

I’ve made a code that is not working as I wish. Can anyone help me figuring out where my mistake is.

Code:

Sub GetSheets()
'Folder with files
    Path = "C:\Users\Document Folder\"

'Go throw all excel files in folder and open them
    FileName = Dir(Path & "*.xls*")
        Do While FileName <> ""
        Workbooks.Open FileName:=Path & FileName, ReadOnly:=True

'Find last used cell in "MasterData" sheet
    lastRow = ThisWorkbook.Sheets("MasterData").UsedRange.Row + 2

' Add the open File name in column A
    ThisWorkbook.Sheets("MasterData").Range("A" & lastRow).Value = FileName
' Copy data from range "A1:X100" from open file, sheet "Order" to column "C:Z" in "MasterData" sheet
    ThisWorkbook.Sheets("MasterData").Range("C" & lastRow).Value = FileName.Sheets("Order").Range("A1:Z90").Value

'Close opened file
    Workbooks(FileName).Close
    FileName = Dir()
  Loop
End Sub

Thank you in advance.
Igor

Sorting Dates from Oldest to Newest with the format YYYY-MM-DD

$
0
0
I'm importing data with the date format as stated above. I have thousands of entries to work with and I'm having a hard time figuring out how to sort it when the date format is given to me this way. Is there any way to either sort it from oldest to newest as is or moving the year to the end and then sorting from oldest to newest as normal? Thanks in advance.

Formula to Determine Disposition of Project

$
0
0
[Ooops. This may belong in Formulas thread. My first thought was put it here because the macro eventually determine what shows, but it is dependeint on the formula. Please move it if I have posted in the wrong thread.]

Greetings, Gurus. I have put the same message in a text box in the attached sample so you don't have to go back and forth. I am hust trying to figure out the right formula to give me the correct disposition. Please review and advise. Thanks in advance.

My formula in column "I" does not give me the desired result. When I run the "Show Active Projects" macro it should show everything that shows "REVISIT" in column "I", and hide everything that shows as "COMPLETED" in column "I".

If the Status on a project is COMPLETE and either there is no date for REVISIT, or the date to revisit is in the future, the DISPOSITION should be COMPLETED.

if the status is complete, but the current date is PAST the revisit date, the disposition should be REVISIT.

IN PROCESS and PENDING should both have disposition of REVISIT if the date is blank or in the past, but have disposition of COMPLETED if the date is in the future.
Attached Files

Add userform textbox value to value in worksheet cell the paste total value into worksheet

$
0
0
Hi Guys,


Struggling with a piece of code, I need to enter goods received from a userform into a worksheet, problem is I need to add what we currently have in stock to received stock first, then enter the total into "In Stock". I have the code to find the correct row & add the "received" value, just need help with the addition before it inputs the total value. Code below should explain what I'm trying to do,

Code:

.Cells(findit.Row, 8).Value = Product7.Value + Row, 12
...if not, happy to explain furthert if required ok, as always thanks heaps guys. - Marco

Need script to copy from multiple sources and make multiple copies if needed

$
0
0
Hello all,
Thanks to the help from Mumps1, this script is doing almost everything I need it to do. I have 2 remaining issues, listed below, that I don't understand enough to fix myself. When looking at the Summary page I have added a macro "Build Example" to show what I would like for the end result to be. The button "Build Report" has the current script attached to it that I need help with. Thank you in advance for any and all help with this.

1. I need it to copy the data entered on the summary page and paste it to the top of the report page before anything else. For the test it would be E9 - E20, but could be as large as E9 - E56 or as short as E9 - E12 when in production.

2. The code recognizes when the install type name changes, but currently it will only copy an item over once and then skip any repeats of the same item name. I need it to copy a template over for each time a specific item is listed in the Install Type column of the summary. Items will always be listed in groups and in the same order as the tabs along the bottom are listed.


Here is a link to the previous post as well. Not sure if this will provide any further clarity, but figure that it can't hurt.

https://www.excelforum.com/excel-pro...fic-cells.html

Stop Toggle Button

$
0
0
Is there a code I can put into a toggle button that will result in an error message and the toggle button being... untoggled?
Code:

Private Sub ToggleButton8_Click()
If ToggleButton1.Value = False Then
MsgBox "Are you forgetting Something?", vbCritical + vbOKOnly, "Stop!"
Exit Sub
Else
If ToggleButton1.Value = True Then
MsgBox "You activated in the correct sequ", vbExclamation, "Congratulations!"
'blah blah other deleted unimportant code for this question
End If
End Sub

My problem with this code is that ToggleButton8 is still being toggled. I tried adding:
Code:

ToggleButton8.Value = False
But that just pops up the msgbox twice.

P.S. I realize I probably would be better off using an command button instead of a toggle button... but... I've already placed about five hundred buttons throughout this workbook which are all coded and working correctly, I am just trying to refine some of the finesses on my document.

P.P.S. Maybe I would also be looking for if there is a way to deactivate togglebutton8 if togglebutton1 is false... or can this be done with command buttons?

P.P.P.S. Although I was wanting the msgbox so I could put a label about what corrective action is needed...

Merge and Split issue

$
0
0
Hi all

Has anyone had any issues with the MergeAndSplit tool. I have previously tested my document using the MMtoDocs tool and all was working perfectly with an Excel to Word mailmerge.
My final merge document however exceeds 256 fields so I am using a .csv and the MergeAndSplit tool.

My issue is with the Marco function. This was working fine on the MMtoDocs but on MergeAndSplit the exact same macro produces the following error:
Pic.png

The tool is producing a PDF and deleting the original word document that is produced as intended.
I have noted that the tool has produced both the original word document and the PDF at the time is crashes however the macro is not being run.
I have also manually tested the macro which is very basic and confirmed that it still works in isolation of being used with the tool.

Can anyone help!!

Thanks

Find specific cell value and count

$
0
0
Hi All, I have got small calculation for my team. I would like to find all team members in my team which are on time. My allowance is 40 mins. In Column D I have got data. From D2:D80, I need short code to calculate all members and get sum in G2.

Refreshing Data Connections Through VBA MS-Access - Not working

$
0
0
I am using XL2016 and have a macro that refreshes Microsoft query connections.
The issue is the refreshes only happen if you step through the macro using the debugger. When you run the macro normally, everything else functions properly, but the data is not refreshed.

Code:


Sub REFRESH()
'Refresh queries based on active sheet.
       
    Sheets("LOADING").Visible = xlSheetVisible
    Sheets("LOADING").Unprotect "sha"
    Sheets("LOADING").Protect "sha", True, True
    Sheets("NEW ENTRY").Visible = xlSheetVeryHidden
    Workbooks(Worksheets("SUPER").Range("B18").Value).Connections("Query - RAW_DATA").REFRESH
    Sheets("NEW ENTRY").Visible = xlSheetVisible
    Sheets("NEW ENTRY").Select
    Sheets("LOADING").Visible = xlSheetVeryHidden
   
End Sub

Worksheets("SUPER").Range("B18") = File name with extension.
I have disabled the background refresh for the query.
Viewing all 49862 articles
Browse latest View live