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

how to set same code twice in one sheet

$
0
0
hello, the following code below will add date and time to the adjacent columns of A, once i add value to column A
im looking for a way to add date and time also to the adjacent columns of D as well, once i add vale to column D

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim A As Range, B As Range, Inte As Range, r As Range
    Set A = Range("A:A")
    Set Inte = Intersect(A, Target)
    If Inte Is Nothing Then Exit Sub
    Application.EnableEvents = False
        For Each r In Inte
            If r.Offset(0, 1).Value = vbNullString Then r.Offset(0, 1).Value = Date
            If r.Offset(0, 2).Value = vbNullString Then r.Offset(0, 2).Value = Time
        Next r
    Application.EnableEvents = True
End Sub

in conclusion it would Auto-fill the columns adjacent to A and D with date and time.

many thanks for your time.

explain use of step 2 in VBA code

Hide sheets if cell value match

$
0
0
hi, everyone

i want to hide all sheets but with four sheets mentioned below, conditions should be apply, if condition met then hide the sheets otherwise no
"A", "B", "C", "D"

Above four sheets hide if
sheets("A") range("g4") is greater then =0
sheets("B") range("g4") is greater then =0
sheets("C") range("g4") is greater then =0
sheets("D") range("g4") is greater then =0


thanx a lot

Copy select data to another column

$
0
0
Please advice how can I copy data to another column
I appreciate beforehand your attention and time.

Code:

Private Sub CheckBox1_Click()
Dim r As Long
If CheckBox1.Value = True Then
For r = 0 To ListBox2.ListCount - 1
ListBox2.Selected(r) = True
Next r
Else
For r = 0 To ListBox2.ListCount - 1
ListBox2.Selected(r) = False
Next r
End If
End Sub


Private Sub cmdbul1_Click()
Dim isim As Range
Application.ScreenUpdating = False
Sheets("Dataform").Activate
If TextBox1 = Empty Then
MsgBox "Please enter A Value To Search"
TextBox1.SetFocus
Exit Sub
End If
ListBox2.RowSource = Empty
ListBox2.Clear
ListBox2.ColumnCount = 9
For Each isim In Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)
If UCase(LCase(isim)) Like UCase(LCase(TextBox1)) & "*" Then
liste = ListBox2.ListCount
ListBox2.AddItem
ListBox2.List(liste, 0) = isim
ListBox2.List(liste, 1) = isim.Offset(0, 1)
ListBox2.List(liste, 2) = isim.Offset(0, 2)
ListBox2.List(liste, 3) = isim.Offset(0, 3)
ListBox2.List(liste, 4) = isim.Offset(0, 4)
ListBox2.List(liste, 5) = isim.Offset(0, 5)
ListBox2.List(liste, 6) = isim.Offset(0, 6)
ListBox2.List(liste, 7) = isim.Offset(0, 7)
ListBox2.List(liste, 8) = Format(isim.Offset(0, 8), "dd.mm.yyyy")

End If
Next
Application.ScreenUpdating = True
End Sub


Private Sub CommandButton1_Click()
Dim Litem As Long, LbRows As Long, LbCols As Long
Dim bu As Boolean
Dim Lbloop As Long, Lbcopy As Long

LbRows = ListBox2.ListCount - 1
LbCols = ListBox2.ColumnCount - 1

For Litem = 0 To LbRows
If ListBox2.Selected(Litem) = True Then
bu = True
Exit For
End If
Next


If bu = True Then
With Sheets("CopyfromDataform").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)

For Litem = 0 To LbRows
If ListBox2.Selected(Litem) = True Then
Lbcopy = Lbcopy + 1
For Lbloop = 0 To LbCols

.Cells(Lbcopy, Lbloop + 1) = ListBox2.List(Litem, Lbloop)

Next Lbloop
End If
Next
For m = 0 To LbCols
With Sheets("CopyfromDataform").Cells(Rows.Count, 1).End(xlUp).Offset(0, m).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = 23
End With
Next
End With

Else
MsgBox "Nothing chosen", vbCritical
End If
MsgBox "The Selected Data Are succes Copied.", vbInformation
Sheets("CopyfromDataform").Select
End Sub


Private Sub CommandButton2_Click()
Dim del As Control
For Each del In UserForm1.Controls
If TypeName(del) = "TextBox" Then
del.Text = Empty
End If
Next del
UserForm_Initialize
End Sub


Private Sub CommandButton3_Click()
Unload Me
End Sub


Private Sub OptionButton1_Click()
ListBox2.MultiSelect = 0
End Sub


Private Sub OptionButton2_Click()
ListBox2.MultiSelect = 1
End Sub


Private Sub OptionButton3_Click()
ListBox2.MultiSelect = 2
End Sub


Private Sub UserForm_Initialize()
Dim say As Integer
Application.ScreenUpdating = False
say = WorksheetFunction.CountA(Worksheets("Dataform").Range("A:A"))
ListBox2.RowSource = "Dataform!A2:I" & say
ListBox2.ColumnCount = 9
ListBox2.ColumnWidths = "60;60;60;60;60;60;60;60;60"
ListBox2.MultiSelect = fmMultiSelectMulti
OptionButton3.Value = True
Application.ScreenUpdating = True
End Sub

userform printscreen.png
Result.JPG
Userform asset.xlsm

Copy Paste to Loop Through Sheets in Workbook

$
0
0
Hola Gurus,

I cannot figure out why this simple copy paste doesn't work... any advice?



Sub CopyPaste()

Dim sh As Worksheet

Application.ScreenUpdating = False

For Each sh In ThisWorkbook.Worksheets

Columns("O:O").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
, SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Next 'sh

End Sub


Thank you for any help!

Formula or VBA to calculate Interest based on different dates

$
0
0
Hello,

I have the following situation and I am completely frustated with the complexity of calculating interest amount manually. Could anyone let me show a way to do the same with the help of a formula or VBA?

Rules.

1.Due date for payment of principal amount is sixth day of next month. ( Except March where the due date of payment is 31st March)

2.From 7th Day Interest will be calculated as follows

Upto 30-Sep-2014 Rate of Interest is 18%

From 01-10-2014 Rates are as follows
1. Upto 6 Months of delay rate of interest is 18%
2. Morethan 6 Months and upto One Year - 18 % for first 6 Months of delay and
24% for the delay beyond 6 Months upto one Year

3. Morethan One Year of Delay - 18 % for first 6 Months of delay
24% for the delay beyond 6 Months upto one Year
30% for any delay beyond one year upto 13-05-2016

From 14-05-2016

24 % for any delay

I am herewith attaching the example sheet ..

Thank you
Attached Files

countif VBA Array's

$
0
0
Hi,

I have two arrays in VBA and I want to count occurrences in 'result array' for each element in my 'id array'.


Code:

Sub test()
Dim id() As Variant
Dim res() As Variant
Dim x As Double

id = Range("A1:A7") 'Values A, B, C, D, E, F and G
res = Range("E1:J30") 'Each column is a sample of elements in Id

x = Application.CountIf(.........) 'I want to count how many times each element of ID occurs in a specific column, or range of columns. It could be 1st column of res or columns 2 - 4.

End Sub

Help is appreciated

Fetch the data between 5 sheets as per the BD name and date selection


Convert negative numbers in column to postive number

$
0
0
How to convert negative numbers in column to positive numbers using VBA? I have a code, but this one Works very slowly and sometimes PC crashes if there is many cells in column.

My code:

Code:

Range("E:E").Select
Dim Cel As Range
For Each Cel In Selection
If IsNumeric(Cel.Value) Then
Cel.Value = Abs(Cel.Value)
End If
Next Cel

[SOLVED] VBA to record current date and time!

$
0
0
Hi guys,

Can someone please help me out with the below.

I would like to create a macro for the below situation.

I would like to create a VBA which when executed will insert the following "Last modified: current date and time " in cell A1 of a sheet called 'Home'.

P.S: the current date and time should be the one when the macro is run.

Thanks a lot for all your help!

Keibri

Pull the contact number's of companies from a webpage and auto-populating in ex

$
0
0
Hi Everyone,

I would like to introduce myself as Karthick.

I need an help from your side, to "Pull the contact number's of companies from a webpage (www.411.ca) and auto-populating in excel through macro".

I already pulled the data from www.yellopages.ca" for the list of company names. I am attaching the output format & also the coding which i did for "www.yellowpages.ca".

Grateful, if anyone can help to pull the contact numbers from the indicated webpage.

Company Names to be populated from 411.ca site.jpg

Coding to pull company names from "www.yellowpages.ca" -

Sub Test()
Dim ie As Object, ieDoc As Object
Dim i As Integer
Dim cName As String, tagcName As String, tagPhone As String
Dim istr As String
Dim cel As Range
Dim x As Variant

Set ie = CreateObject("InternetExplorer.Application")

For Each cel In Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)
If cel.Offset(, 3) = "" Then
cName = Replace(cel.Value, " ", "+")

Url = "http://www.yellowpages.ca/search/si/1/" & cName & "/" & cel.Offset(, 2).Value

ie.navigate Url

Do Until (ie.readyState = 4 And Not ie.Busy)
DoEvents
Loop
Set ieDoc = ie.Document

istr = ieDoc.All(0).innerHTML
If htmlCheck(istr) Then
cel.Offset(, 3).Value = "Not Found"
GoTo Skip2:
End If

On Error GoTo Skip:
tagcName = ieDoc.getElementsByClassName("listing__name--link jsListingName")(0).innerText
cel.Offset(, 5).Value = tagcName
Skip:
Resume NextStep:
NextStep:
On Error GoTo Skip1:
tagLink = ieDoc.getElementsByClassName("mlr__item__cta")(0).href
x = Split(tagLink, "?")
cel.Offset(, 4).Value = x(UBound(x))
Skip1:
Resume NextStep1:
NextStep1:
On Error GoTo Skip2:
tagPhone = ieDoc.getElementsByClassName("mlr__submenu__item")(0).innerText
cel.Offset(, 3).Value = tagPhone
End If
Skip2:

Next cel

Set ie = Nothing
'MsgBox "Process Complete"
End Sub

Public Function htmlCheck(pStr As String) As Boolean
Dim regex As Object
Set regex = CreateObject("VBScript.RegExp")

With regex
.Pattern = "\b(We didn’t find any business listings matching)\b"
End With

htmlCheck = regex.Test(pStr)
End Function

Thanks
Kaarthick

Dependent Comboboxes

$
0
0
I am a bit new to the aspect of dependent comboboxes.. I have attach a examplefile where I got a Userform with two comboboxes (Cb1 & Cb2). In my sheet (Sheet1) I got two columns. Column A is a "QSS ID" and in column B there is a "QSS Name". In my combobox1 (Cb1) I want my "QSS ID" and in my second combobox I would like to have my "QSS Name". Therefore If I change combobox2 then I want the combobox1 to automatically change to the correct "QSS ID". If I instead change combobox1 to another "QSS ID" then there might be several "QSS Names" with that ID and therefore the combobox should be a dropdown list of the correct names. How can I do this in a good way?
Attached Files

scrabble hook macro

$
0
0
Find attached file

I have done manually on column i results of a word combining with letters on B as front hook and C as back hook
Example

ABA bcy cs

ABAB
ABAC
ABAY
CABA
YABA

I want the macro to do me this for all words on column A
Attached Files

Rearrange column with fixed headers

$
0
0
Raw tab is raw data generated from system. Every time I need to manually copy and paste to remove the columns become result tab header.

How to write VBA code to skip the manual workaround?

Help.
Attached Files

how to add a date when opening up the worksheet

$
0
0
so i have a worksheet "Production Timesheet Checklist" that has a field with a date in it.

i need a macro that adds "7" to a date field ("B1"). Also need the macro to ask if the date should be updated.

i guess i need the worksheet open function to make this work. not sure of what else i need to do.

thoughts everyone?

Force Edit Input Error / Hide Background Processing

$
0
0
Hi,
I am a newbie to Excel VBA. I have created a Userform which (mostly) works. It currently works if the data entry field are completed properly and if all my background sheets are visible.

1. I found this code on another thread which I am trying to adapt to an individual field level.

Private Sub CommandButton1_Click()
If TextBox1.Value = "" Then
MsgBox "Textbox 1 uncompleted"
Exit Sub
End If
'... Do something else
End Sub

When I tab out of the field, the MsgBox works fine but it does not go back to the field that needs to be fixed. If the Last Name is left blank, how can I get it to stay on the Last Name field.

Private Sub tbLastName_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If Me.tbLastName = "" Then
MsgBox "Field cannot be blank", vbCritical

Else

End If
Me.tbLastName = UCase(Me.tbLastName)

End Sub

2. This is just meant to be a very simple project to accept input data and create a PDF Barcode file. I am using 3 combo boxes to limit what goes into the fields. At some point I am looking to add a Search to determine if the Last 4 of the SS# and Last Name match any previous records to autofill Last 4 and Name fields (again to limit typo errors). I would like to keep all the worksheets I use to store my tables for data and filling my comboboxes invisible to the person that will be using my mini-app. However I have found when worksheets are invisible, I cannot address them with my code. Is there a way around this?

Thanks All!!!

Hide/Show Custom Ribbon Selections

$
0
0
Greetings all,
I hope you had a Merry Christmas and I wish you all a safe and blessed New Year.

I am working on making a spreadsheet that engineers will use to create the base configuration for some firewalls. There is quite a bit in the spreadsheet, but my question today is about dynamically customizing the custom ribbon I have created. I have created a ribbon called "Firewall Commands" and what I am trying to do is based on the selection the user puts in the "HA Pair C6 cell" I want the ribbon to show different options.

So if HA Pair is YES
1. Initial Check Tab which calls-> sub copyContentsofInitialCheckTab
2. FW1 HA which calls-> sub copyFW1HA
3. FW2 HA which calls-> sub copyFW2HA
4. FW1 Shared Management and vdom support which calls-> sub copySharedManagement
5. FW1 Base Config which calls-> sub copyFW1BaseConfig
6. FW2 Base Config which calls-> sub copyFW2BaseConfig

But if HA Pair is NO
1. Initial Check Tab which calls-> sub copyContentsofInitialCheckTab
2. Management and vdom support which calls-> sub copySharedManagement
3. FW Base Config which calls-> sub copyFW1BaseConfig

So the names would change slightly but in essence they would still call existing subs.

I am not sure how to made vba modifications to the ribbons and any help would be appreciated. I have attached a copy of the spreadsheet if that helps.

Thanks in advance and if you have questions on what I am trying to accomplish please feel free to reach out to me.

One other thing I noticed was that because I created the Ribbon in excel, it shows up everytime I open excel now. I was hoping to have that Ribbon only show up in the workbook that it was created for.

THANKS
Wally
Attached Files

Currency formatting macro for pivot tables

$
0
0
Hi there,

I have a macro that turns numbers into the currency format that my company likes to use, and I am wondering if there is an easy way to apply this format to a field in a pivot table.

Code:

Sub Currency_format()
'
' Currency_format Macro
'

'
    Selection.NumberFormat = "$#,##0_);[Red]($#,##0)"
End Sub

It's a pain to change the number format of a pivot field every single time I make a pivot! Any help is appreciated, thanks in advance.

Generate hyperlinks in an excel cell, and populate the columns in the resulting form?

$
0
0
Hi Friends,

I want to know how can i generate a hyperlink in an excel cell and populate the data present in different columns in the same spreadsheet in to a form( form loaded in a webpage after clicking the hyperlink created).

I would be obliged if anyone could help me with the same.

Regards,
Prabhuram

[SOLVED] row source extended

$
0
0
on my combo box where I pick my "locations" I need more rows, in properties under row source its I have "LOC" Is there a way to extend the row source or do I have to delete that row source and create another, if so I would like to know how to delete it, and even though I made it like 5 years ago, I forgot how I made it lol, a little help would be appreciated.

thanks
keith
Viewing all 50112 articles
Browse latest View live