I have a excel workbook name prog.xls in D:\
in sheet1 i have 3 column contains n number of records with first row as a column heading
column1-Name,Column2-DOB,Column3-Email_Id.
I want to match DOB to current date to check whose Birthday is today and want to copy corresponding Email_Id to sheet2.
Below Is My code
MyDate=Date
Set myxl = createobject("excel.application")
myxl.Workbooks.Open "D:\prog.xls"
set mysheet = myxl.ActiveWorkbook.Worksheets("Sheet1")
Row=mysheet.UsedRange.Rows.Count
For i= 2 to Row
If Mysheet.cells(i,2).value =Day(MyDate)&"/"&Month(MyDate) Then
above code is working fine,but its not complete. it will only check. but how to store corresponding Email_ID into sheet2. Please help me.
Thanks in Advance
Please try the below code and let me know.
MyDate=Date
Set myxl = createobject("excel.application")
myxl.Workbooks.Open "D:\Form.xls"
myxl.application.Visible = True
set mysheet = myxl.ActiveWorkbook.Worksheets("Sheet1")
Row=mysheet.UsedRange.Rows.Count
j=1
For i= 2 to Row
If mysheet.cells(i,2).value =Day(MyDate)&"/"&Month(MyDate) Then
Email=mysheet.cells(i,3).value
set mysheet = myxl.ActiveWorkbook.Worksheets("Sheet2")
mysheet.cells(j,1)=Email
j=j+1
set mysheet = myxl.ActiveWorkbook.Worksheets("Sheet1")
End If
Next
myxl.ActiveWorkbook.save
myxl.quit
Set myxl =Nothing
Thanks
Related
I want to create a macro that will generate N number of template sheets based on the value of a cel. For example, User inputs 4 into this particular cell and it subsequently generates 4 new sheets in the workbook of this template.
I've searched all through Stack overflow for a question that matches mine but none do. The closest I found was this and although the inital headline question asks generally the same question, when going into detail the user who asked this changes their question to"insert number of cells based on a cell value". Still I used this as a starting point.
Sub CreateSheets()
Dim facilitiesNum As Integer
facilitiesNum = Range("B2").Value
sheetsNeeded = facilitiesNum
With ThisWorkbook.Sheets
For i = sheetsNeeded To Master.Range("B2").Value2
.Item("TemplateSheet").Copy After:=.Item(.Count)
.Item(.Count).Name = sheetsNeeded
Next
End With
End Sub
I am new to VBA so I could be very off syntax-wise but in pseudocode my goal is
numberOfTemplates = cell value
numSheetsNeeded = numberOfTemplates
For i = numSheetsNeeded To NumOfTemp:
create sheets using numSheetsNeeded as reference for how many need to be
generated
How do I go about doing this?
If you just want to add new sheets this should be enough
Sub CreateSheets()
Dim facilitiesNum As Long
facilitiesNum = Range("B2").Value
With ThisWorkbook.Sheets
For i = 1 To facilitiesNum
.Item("TemplateSheet").Copy After:=.Item(.Count)
.Item(.Count).Name = i
Next i
End With
end sub
Dim path_feb As String
Dim path_mar As String
Dim wkbk_feb As Workbook
Dim wkbk_mar As Workbook
path_feb = "D:\Tranzit\2016\feb\data_feb.xlsx"
Set wkbk_feb = Workbooks.Open(path_feb)
path_mar = "D:\Tranzit\2016\mar\data_mar.xlsx"
Set wkbk_mar = Workbooks.Open(path_mar)
Worksheets("monthly").Range("A2:A1000").Value = Windows("wkbk_feb").Worksheet("impuls").Range("A2:A1000").Value
Worksheets("monthly").Range("B2:B1000").Value = Windows("wkbk_mar").Worksheet("impuls").Range("A2:A1000").Value
End Sub
I need a little help to work this code.
The issue begin here:
Worksheets("monthly").Range("A2:A1000").Value = Windows("wkbk_feb").Worksheet("impuls").Range("A2:A1000").Value
So, I have 3 files with different path:
D:\Tranzit\2016\feb\data_feb.xlsx
D:\Tranzit\2016\\mar\data_mar.xlsx
D:\Tranzit\2016\data_final.xlsm
I want to copy from file 1 the range A2:A1000 from "Sheet" Impuls to file 3 in range A2:A1000 from "Sheet" monthly.
and
copy from file 2 the range A2:A1000 from "Sheet" Impuls to file 3 in range B2:B1000 from "Sheet" monthly.
You declared wkbk_feb and wkbk_mar as workbook objects so you need to reference them directly:
wkbk_feb.Worksheets("impuls")....
instead of activating or selecting anything you should always specify the workbook or worksheet. So it should look something like
wkbk_total.Worksheets("monthly")... = wkbk_feb.Worksheets("impuls")....
Y helo thar,
actually my vba-knowledge is quite good and normally I don't have many difficulties coding , but this is driving me nuts.
Code is pretty easy. I have a worksheet PR_DB where all my projects are stored. For every project there are a number of employees, saved in cells (sel_pr, >10+) (employee name and ID).
I want to delete an employee from the project and tidy up the project database entry. All employees are listed in two listboxes. The ones that are working in the project, and the ones that don't. Via the buttons I can add and remove employees from either listbox.
When I add an employee to a project (top button), my Sub just puts the ID&Name at the end of the row of said project.
When I remove them from a project and therefore from the database, I look for the cell with the employee data. Afterwards I just want to cut all the cells to the right and paste them one cell to the left (via offset) so the deleted name is overwritten.
This is my code:
Sub delMA_from_prBetList()
Dim i, j, k, listRow, lastRowMA_DB, lastRowPR_DB, sel_pr As Integer
Dim wsPR, wsMA_DB, wsPR_DB As Worksheet
Dim foundMA As Boolean
Dim cutRng, pasteRng As Range
Set wsPR = Worksheets("Projekte")
Set wsMA_DB = Worksheets("MA_DB")
Set wsPR_DB = Worksheets("PR_DB")
lastRowPR_DB = wsPR_DB.UsedRange.Rows.Count
'check if any employee was selected
If IsNull(wsPR.prBetListe.Value) = True Then
MsgBox "Please select an employee."
Exit Sub
End If
j = 10
'look for selected project in DB
For i = 2 To lastRowPR_DB
If wsPR_DB.Cells(i, 1) = CInt(wsPR.prListe.Value) Then
'row ID of said project
sel_pr = i
End If
Next
'find employee
Do Until wsPR_DB.Cells(sel_pr, j) = ""
'employees are saved as "ID;NAME"
If wsPR_DB.Cells(sel_pr, j) = wsPR.prBetListe.Value & ";" & wsPR.prBetListe.Column(1, wsPR.prBetListe.ListIndex) Then
'when found, look for last cell with an entry
k = j
Do Until wsPR_DB.Cells(sel_pr, k) = ""
k = k + 1
Loop
'set cutRng so it spans from cell right to the found employee
'to last cell with an employee in that project
Set cutRng = wsPR_DB.Range(wsPR_DB.Cells(sel_pr, j + 1), wsPR_DB.Cells(sel_pr, k))
'set pasteRng like cutRng, just one cell further to the left
'so the deleted employee will be overwritten
Set pasteRng = cutRng.Offset(rowOffset:=0, columnOffset:=-1)
cutRng.Cut
pasteRng.PasteSpecial
Exit Do
End If
j = j + 1
Loop
're-initialize listboxes
Call init_maListe_dyn
Call init_prBetListe_dyn
End Sub
So whats the problem? Everything works just fine, all the cells I want to cut go into clipboard, but they arent pasted into the pasteRng. Error is
Error 1004 "Application-defined or Object-defined error". I tried a thousand things but the solution is probably too easy to find.
Hope you can help me, thanks in advance.
PS: I'm kind of in a hurry, so that text might not be as well formatted as it could be. Please bear with me.
just use directly:
cutRng.Cut pasteRng
this should solve your problem ;)
If you want to offset one column to the left it should be
Set pasteRng = cutRng.Offset(,-1)
Also, you're not defining how you want to paste. The paste settings may not be set to paste values if they were set differently prior to this instance (via code or otherwise). If you want to just cut-paste the values it would be
cutRng.Cut
pasteRng.PasteSpecial xlPasteValues
Let me know if that helps at all and if not I'll look further into it.
I'm very new to programming (1 day experience) and I am trying to build an interactive database but I keep running into issues with having a certain part work.
I want Excel to read the value selected in a certain cell and based on the value in that cell then have it open to a separate sheet, where I can begin another set of data entry.
I have tried a number of different options but as of now, my code looks like this:
Dim inputWks As Worksheet
Set inputWks = ("Input")
With inputWks
If Range("D13").contents = "Yes" Then
ActiveWorkbook.Sheets("Sheets2").activate
End If
End With
I know this is a simple question but I have not been able to have this work..
try this
Sub DoIt()
Dim inputWks As Worksheet
Set inputWks = ActiveWorkbook.Sheets("Input")
With inputWks
If Range("D13").Cells(1, 1) = "Yes" Then
ActiveWorkbook.Sheets("Sheets2").Activate
End If
End With
End Sub
I am stuck with this sitaution. I read the forum and have tried numerous methods to solve this but nothings working.
Here is the scenario:
I am autogenerating an excel worksheet using vb.net. This worksheet gets populated with 200 data values in column A and 200 different data values in column B. I then find the maximum value of column B with its associated address (e.g. maxvalue = 2.59, address $B$89 ). I now need to find the value of the adjacent cell (in column A) and display that value in a message box.
Any help will be much appreciated.
Thanks
Sudhir
Dim xlsApp As Excel.Application = Nothing
Dim xlsWorkBooks As Excel.Workbooks = Nothing
Dim xlsWB As Excel.Workbook = Nothing
Try
xlsApp = New Excel.Application
xlsApp.Visible = True
xlsWorkBooks = xlsApp.Workbooks
xlsWB = xlsWorkbooks.Open("c:\my_excel_file.xls")
xlsWB.Range("B89").Select 'This will move the cursor to B89 cell
Dim myValue as String = ""
myValue = xlsWB.Activecell.Offset(0,-1).Value
'Offset(0,-1) means we are interested in the
'cell in which lies on the same row (0 for y axis)
'and to the left of the current one, by one cell
'which means -1 . If we want the cell in column D92 then
'we would use Offset(3,2)
Catch ex As Exception
Finally
xlsWB.Close()
xlsWB = Nothing
xlsApp.Quit()
xlsApp = Nothing
End Try