Quantcast
Channel: Active questions tagged excel - Stack Overflow
Viewing all 88206 articles
Browse latest View live

Google Sheets match item from different code

$
0
0

sorry if this is a silly question but I don't even know how to search for it, for real.

The situation is that I have a product control sheet for my inventory and I have combinations of it that I will call them as Kit1, Kit2 and so on...

When I input a customer's purchase it will deduct the number of itens sold from my inventory, until this I could make it happen. Now I need to create those Kits so when I add the purchase of a Kit that contains Item1, Item2 and Item3, that I will deduct those three itens from my inventory.

I have been using vlookup for it but I don't see how to succeed using it.

Thanks.


Enter military time in Excel without ":"

$
0
0

I'm using this script I found on the Microsoft forum to allow me to enter military time without having to enter the ":" every time. It works fine, until I add a blank row or delete a row. Then I get an error. How can I get this code to ignore deletions and additions in the range that don't meet the expected format?

 Private Sub Worksheet_Change(ByVal Target As Range)
 If Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub
 Dim xHour As String
 Dim xMinute As String
 Dim xWord As String
 Application.EnableEvents = False
 xWord = Format(Target.Value, "0000")
 xHour = Left(xWord, 2)
 xMinute = Right(xWord, 2)
 On Error Resume Next
 Target.Value = TimeValue(xHour & ":"& xMinute)
 On Error Resume Next
 Application.EnableEvents = True
 End Sub

how to import excel form in informatica? I want to import data from excel form to informatica and finally insert into DB table

$
0
0

I want to import data from excel form to informatica and finally insert into DB table. the data in the excel is in key:value format(ex. name : "xyz"(in the next right cell)) how can i import that data such that the "Name" becomes the column name and "xyz" becomes the data in informatica source?

InputBox data validation and end loop

$
0
0

I have some code to enter dates via InputBox (see below). The problem is that the Else doesn't work (ie. if the user enters something other than the format mm/dd/yy it doesn't stop). How do I make it so that the user has to enter it in the format presented?

Also, I want to end the loop with the endDate. Right now, if you enter 01/10/20 as the start date and 12/31/20 as the end date, it will stop at January 1, 2021. How do I make it stop at December 31, 2020?

  Dim startDate As Date
  Dim endDate As Date

  startDate = InputBox("Enter project start date in format mm/dd/yy", "User date", Format(Now(), "dd/mm/yy"))
  endDate = InputBox("Enter project end date in format mm/dd/yy", "User date", Format(Now(), "dd/mm/yy"))

  If IsDate(startDate) Then
    startDate = Format(CDate(startDate), "mmm d, yyyy")
  Else
    MsgBox "Wrong date format"
  End If

  If IsDate(endDate) Then
    endDate = Format(CDate(endDate), "mmm d, yyyy")
  Else
    MsgBox "Wrong date format"
  End If

Range("A2").Value = startDate

Dim i As Long
Dim j As Long
Dim x As Integer

i = startDate
j = endDate
x = 3

Do Until i >= j
    Cells(x, 1).Value = i + 7
    i = i + 7
    x = x + 1
Loop

End Sub```

VBA if A = B and C= Text

$
0
0

I have been looking on stackoverflow but could not get an definitive answer to my little problem. I am fairly new to coding and am still dealing with syntax sometimes.

Right now I have a little loop reading an array, inside the loop it checks for an if statement. I have been checking the loop which works fine, and the array as well. The if statement works until im starting to use "isText".

After searching a bit I noticed "isText" is not a function, is there something equivalent?

Right now my if statement goes as follows: IF A = B and C (Contains ANY value at all) then Write something somewhere in a cell

Right now the code I am using is:

Sub KnopKlik()

Dim Soorten(10)
Dim Teller As Integer
Dim Column1 As String
Column1 = Sheets(2).Range("C1").Value

MsgBox (Column1)
Sheets(1).Select
Range("E2").Select

For Teller = 0 To 10
    Soorten(Teller) = ActiveCell.Offset(Teller).Value

Next Teller


For Teller = 0 To 10

If Sheets(2).Range("B9") = Soorten(Teller) And Application.IsText(Column1) Then

    MsgBox ("Check")
    Sheets(2).Range("E9").Value = ActiveCell.Offset(Teller, 3)
    Sheets(2).Select
    Range("B9").Select

    Teller = 10
    Else
End If


Next Teller

End Sub

Right now the last part of the if statement is the problem

And Application.IsText(Column1) Then

EDIT**

This is how I solved it now. Basically whenever there is ANYTHING at all in that cell it will pass through.

If Sheets(2).Range("B9") = Soorten(Teller) Then
'Als B9 Gelijk is aan (database) DAN!>>>
    If Not Column1 = "" Then
    Sheets(2).Range("E9").Value = ActiveCell.Offset(Teller, 3)
    End If
    Else
End If

Thanks in advance.

How can I use this VBA code to import multiple selections from multiple sheets into an identical location in another workbook?

$
0
0

The below code allows the user to select a data range in another workbook and then paste it in another selection in the starting workbook.

Dim wkbCrntWorkBook As Workbook
Dim wkbSourceBook As Workbook
Dim rngSourceRange As Range
Dim rngDestination As Range
Set wkbCrntWorkBook = ActiveWorkbook
With Application.FileDialog(msoFileDialogOpen)
    .Filters.Clear
    .Filters.Add "Excel 2007-13", "*.xlsx; *.xlsm; *.xlsa"
    .AllowMultiSelect = False
    .Show
    If .SelectedItems.Count > 0 Then
        Workbooks.Open .SelectedItems(1)
        Set wkbSourceBook = ActiveWorkbook
        Set rngSourceRange = Application.InputBox(prompt:="Select source range", Title:="Source Range", Default:="A1", Type:=8)
        wkbCrntWorkBook.Activate
        Set rngDestination = Application.InputBox(prompt:="Select destination cell", Title:="Select Destination", Default:="A1", Type:=8)
        rngSourceRange.Copy rngDestination
        rngDestination.CurrentRegion.EntireColumn.AutoFit
        wkbSourceBook.Close False
    End If
End With

However, the location of the data I am importing is in the exact same location but it is on different sheets within the imported workbook. All of the sheets are the same in both workbooks but the idea is to import new data into the old workbook because there is embedded formulas within the old workbook. How can I modify this Macro so that all of the sheets can be imported at the same time & replace the old data in the old workbook?

I tried altering the code to directly copy the data range of the first sheet and paste it into the same location in the old workbook but ended up with an "Subscript Out of Range" error. The idea was to create a loop to do this to the respective locations as a loop so that the macro would copy and paste all of the new values from each sheet (There are 8 sheets in both) into the old workbook. See below:

 Dim wkbCrntWorkBook As Workbook
Dim wkbSourceBook As Workbook
Dim rngSourceRange As Range
Dim rngDestination As Range
Set wkbCrntWorkBook = ActiveWorkbook
With Application.FileDialog(msoFileDialogOpen)
    .Filters.Clear
    .AllowMultiSelect = False
    .Show
    If .SelectedItems.Count > 0 Then
        Workbooks.Open .SelectedItems(1)
        Set wkbSourceBook = ActiveWorkbook
        Set rngSourceRange = ActiveWorkbook.Sheets("Sheet1").Range("B4:K53").Value
        wkbCrntWorkBook.Activate
        Set rngDestination = ActiveWorkbook.Sheets("Sheet1").Range("B4:K53").Value
        wkbCrntWorkBook.Activate
        rngSourceRange.Copy rngDestination
        rngDestination.CurrentRegion.EntireColumn.AutoFit
        wkbSourceBook.Close False
    End If
End With

I apologize for being long-winded but wanted to show that I did make an effort to solve this. Please help!

VBA - How can I find last row in dynamic file/Vlookup in two different workbook

$
0
0

I am trying to use Vlookup function to look up 3 columns between Two workbook(these 3 columns are at the exact same column). However, I realize that because of the row number are different between two workbook so I have to figure out the total row number in the source file so that I can do vlookup accordingly ( correct me if this is the run way to start) The following is my code to start with and it looks like not working for me it keeps count the rows in destination file. If anyone can correct me I am going to the wrong way. Any thought will be appreciated.

Sub practice()

Dim SourceLastRow As Long
Dim sourceBook As Workbook
Dim sourceSheet As Worksheet
Dim destinationSheet As Worksheet
Dim DestinationLastRow As Long
Dim destinationBook As Workbook



'Application.ScreenUpdating = True

'Set selsheet = ActiveSheet

'Where is the source workbook?
Set sourceBook = Workbooks.Open("C:\Location 02-19-2020.xlsb")

'what are the names of our worksheets?
Set sourceSheet = sourceBook.Worksheets("B")
'selsheet.Activate


'Determine last row of source
With sourceSheet
    SourceLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
MsgBox "Last Row: "& SourceLastRow



'Where is the destination workbook?

Set destinationBook = Workbooks.Open("C:\Location 02-20-2020.xlsb")

'what are the names of our worksheets?

Set destinationSheet = destinationBook.Worksheets("B")
selsheet.Activate



'Prep for VLOOKUP in source file

'Insert the row in destination file

Range("A1").EntireRow.Insert

'Using indexes so that I can drag to do vlookup
Range("AG1").Value = 19
Range("AH1").Value = 25
Range("AI1").Value = 26
'These are the place that I want to insert vlookup
Range("AG2").Value = "S"
Range("AH2").Value = "R"
Range("AI2").Value = "O"

End Sub

How to send text to some HTML elements through Selenium VBA?

$
0
0

I have been having trouble on referring to a search box on a website through Selenium in VBA. The HTML code of the box is:

<input type = "search" class ="form-control input-sm"
placeholder aria-controls="result_table"> ==$0

I have tried

bot.findElementByCssSelector(".form-control").SendKeys ("werresf")
bot.findElementByCssSelector(".form-control.input-sm").SendKeys ("werresf")
bot.findElementByCssSelector(".input-sm").SendKeys ("werresf")
bot.findElementByCssSelector(".form-control input-sm").SendKeys ("werresf")
bot.findElementByClassName("form-control input-sm").SendKeys ("werresf")

But none of them seems to work. Any help is greatly appreciated.


Trying to fill text in input box with dynamic drop down

$
0
0

I need some help. Chrome (v 75.0.3770.100) using Selenium Basic ChromeDriver (v 75.0.3770.140) in Excel (2013) VBE. There's an input box which generates a dynamic list if the customer id# exists. I wish to fill in the customer id# then select from the dynamic drop down. But first step, I'm struggling to input my text to the box. I'm able to click on the box with

obj.FindElementById("selectcustTxt").Click

but when I try to fill in the box with:

obj.FindElementById("selectcustTxt").Value = "1111"

I get an error Run-time error '424': Object required

I tried the following FindElementByXPath with both .Value and .Text but get the same Run-time error '424': Object required

obj.FindElementByXPath("//input[@class='form-control cust-autosuggest ng-pristine ng-valid ng-touched'][@id='selectcustTxt']").Value = "1111"

Here's the HTML:

<div class="form-group search-field"><input id="selectcustTxt" type="text" class="form-control cust-autosuggest ng-valid ng-touched ng-dirty ng-valid-parse" autocomplete="off" plshholder="Enter Cust name" autocomplepte="off" ng-model="cust" suggest-type="custService" sh-autosuggest="custAddresses" data-validation="required">

Excel Macro to identify specific icon and filter by it

$
0
0

We are currently downloading a report to an Excel which has processes names and an icon in the line next to it. There are only 3 types of icons, a square, a square split in 3 and a circle. Each one of them represents a type of process, it would be useful if we could identify the specific icon with a macro and group it.

These are the icons, I can't show the info but there are processes name next to them in the same cell:

Icons in Excel

I don't know how can this be done, if someone has a way to help I'd be grateful.

Thanks in advance.

Finding email items with a certain text in the subject line - optimization

$
0
0

I have basically semi-completed my VBA code for a project but I feel like it needs to be improved or optimized. Can I ask for help on what to change/modify/remove/optimize?

I am relatively new to VBA.

My code is the following:

Function WorksheetExists(sheet_name As String, Optional wb As Workbook) As Boolean
    Dim ws As Worksheet
    If wb Is Nothing Then Set wb = ThisWorkbook

    On Error Resume Next
        Set ws = wb.Sheets(sheet_name)
    On Error GoTo 0

    WorksheetExists = Not ws Is Nothing
End Function

Sub GetEmailDetailsInWorksheets()
    Dim outlook_app As Outlook.Application
    Dim namespace As Outlook.namespace

    Dim folders_collection As New Collection
    Dim folder As Outlook.MAPIFolder
    Dim sub_folder As Outlook.MAPIFolder
    Dim obj_mail As Outlook.MailItem
    Dim obj_item
    Dim row_number As Long
    Dim msgs_found_counter As Long
    Dim working_ws As Worksheet
    Dim active_cell_value As String

    Set outlook_app = New Outlook.Application
    Set namespace = outlook_app.GetNamespace("MAPI")
    Set working_ws = Sheets("Working")
    active_cell_value = ActiveCell.Value

    For Each folder In namespace.Folders
        For Each sub_folder In folder.Folders
            folders_collection.Add sub_folder
        Next sub_folder
    Next

    row_number = 4
    msgs_found_counter = 0

    If ActiveSheet.Name = "Working" Then
        If active_cell_value <> "" Then
            If WorksheetExists(active_cell_value) = False Then
                Sheets.Add(After:=Sheets("Working")).Name = active_cell_value
                Cells(row_number - 1, 1) = "Entry ID"
                Cells(row_number - 1, 2) = "Folder Path"
                Cells(row_number - 1, 3) = "Received Time"
                Cells(row_number - 1, 4) = "Sender"
                Cells(row_number - 1, 5) = "Recipients"
                Cells(row_number - 1, 6) = "Email Subject"
                MsgBox "PRESS OK TO CONTINUE."

                Do While folders_collection.Count > 0
                    Set folder = folders_collection(1) 'Get next folder to process
                    folders_collection.Remove 1        'Remove that folder from the collection

                    Application.StatusBar = folder.FolderPath

                    For Each obj_item In folder.Items
                        If obj_item.Class = olMail And InStr(1, obj_item.Subject, active_cell_value, vbTextCompare) > 0 Then
                            Set obj_mail = obj_item
                            Application.StatusBar = row_number & " - "& folder.FolderPath

                            On Error Resume Next
                            Cells(row_number, 1) = obj_mail.EntryID
                            Cells(row_number, 2) = folder.FolderPath
                            Cells(row_number, 3) = obj_mail.ReceivedTime
                            Cells(row_number, 4) = obj_mail.Sender
                            Cells(row_number, 5) = obj_mail.To
                            Cells(row_number, 6) = obj_mail.Subject
                            On Error GoTo 0

                            row_number = row_number + 1
                            msgs_found_counter = msgs_found_counter + 1
                        End If
                    Next obj_item

                    'Check for subfolders
                    For Each sub_folder In folder.Folders
                        folders_collection.Add sub_folder, before:=1
                    Next
                Loop
                MsgBox msgs_found_counter & " message/s found for """& active_cell_value & """"
                Range("A4").Select
            Else
                MsgBox "A sheet matching the selected cell already exists. Redirecting you now..."
                Worksheets(active_cell_value).Activate
            End If
        Else
            MsgBox "Active cell is blank."
        End If
    Else
        MsgBox "You are in the wrong worksheet. Try again."
    End If

    Application.StatusBar = False
End Sub

Any guidance would be highly appreciated. I need help with the nested ifs or simplications of any lines of code. Thank you.

How to Sort all Color Columns to the Left?

$
0
0

I have a large worksheet with Rows from A-JP full of data. I'm going through, and coloring the Columns that I want to separate into another sheet. Once I've identified those Columns, I want to sort all of the Colored Columns to the Left (Example: A-Z). Then on another sheet (same workbook) I'm going to reference those columns that are colored (I know how to do this).

So the question is: How do I sort all of the Colored Columns to the Left (Example: A-Z). Also how do I do this so that the data in the other columns isn't skewed?

Thanks

copy data from source sheet to last row of destination sheet

$
0
0

I would like to carry out the captioned task with the code

Sub COPYTOLASTROW()
Dim LRDest As Long, SrcRng As Range
With Sheets("source")
Set SrcRng = .Range("B16:E20")
End With
With Sheets("summary")
LRDest = .Cells(.Rows.Count, 1).End(xlUp).Row
SrcRng.Copy .Cells(LRDest + 1, 1)
End With
End Sub

The code above was based on the thread Copy data from one sheet to the last row of another sheet.

However, I only want to paste VALUES to destination. What should I do to the code above?

How to avoid run-time error -2147221080 (800401a8): Automation error? VBA

$
0
0

I wrote a macro that aims to open a workbook and split it into separate workbooks according to the names in a columns. I've done it many times with several macros but not this time.

The loop stops after creating correctly the first workbook because I get either a "run-time error -2147221080 (800401a8): Automation error" or "System Error &H800401A8 (-2147221080)".

I unsuccessfully looked for a solution in the internet all day long.

Here my code:

Sub Spacchettamento()

Application.ScreenUpdating = False

Dim FoglioMacro As Worksheet
Set FoglioMacro = ThisWorkbook.Sheets("Macro")

Dim FoglioParametri As Worksheet
Set FoglioParametri = ThisWorkbook.Sheets("Parametri")

Dim Percorsi As Worksheet
Set Percorsi = ThisWorkbook.Sheets("Percorsi")

Dim StatisticheFolderName As String
StatisticheFolderName = Percorsi.Range("A2").Value

Dim DialogBoxFileStatistiche As Office.FileDialog
Dim StatisticheFileName As String

Set DialogBoxFileStatistiche = Application.FileDialog(msoFileDialogFilePicker)

With DialogBoxFileStatistiche
    .Filters.Clear
    .Filters.Add "Excel Files", "*.xlsx?", 1
    .Title = "Seleziona file Statistiche"
    .AllowMultiSelect = False

    .InitialFileName = StatisticheFolderName '

    If .Show = True Then
        StatisticheFileName = .SelectedItems(1)
    End If
End With

Dim FileStatistiche As Workbook
Set FileStatistiche = Workbooks.Open(StatisticheFileName)
FileStatistiche.Activate

Dim FoglioTotale As Worksheet
Set FoglioTotale = Sheets(1)
FoglioTotale.Activate

Dim NuovoWorkbook As Workbook
Dim NuovoSheet As Worksheet

Dim PercorsoSalvataggio As String
PercorsoSalvataggio = FoglioParametri.Range("A9").Value

Dim NomeFileAsm As String
NomeFileAsm = FoglioParametri.Range("A13").Value

' here i want to create a list of names from the whole file and then start a loop
UltimaRiga = FoglioTotale.UsedRange.Rows(FoglioTotale.UsedRange.Rows.Count).Row 'find last row
FoglioTotale.AutoFilterMode = False
FoglioTotale.Range("E10:E"& UltimaRiga).Copy
FoglioParametri.Range("M1").PasteSpecial
FoglioParametri.Range("M1").RemoveDuplicates 1, xlYes

Dim i As Integer

For i = 2 To Application.CountA(FoglioParametri.Range("M:M"))

    FoglioTotale.Range("A10:AO"& UltimaRiga).AutoFilter 5, FoglioParametri.Range("M"& i).Value

    Set NuovoWorkbook = Workbooks.Add
    Set NuovoSheet = NuovoWorkbook.Sheets(1)
    ThisWorkbook.Activate
    NuovoSheet.Name = "LENTI SK+STV"

    FoglioTotale.Range("J1:W1").EntireColumn.Ungroup
    FoglioTotale.Range("J1:W1").EntireColumn.Hidden = False
    FoglioTotale.Range("AG1:AI1").EntireColumn.Hidden = False

    UltimaRiga2 = FoglioTotale.UsedRange.Rows(FoglioTotale.UsedRange.Rows.Count).Row
    FoglioTotale.Range("A1:AO"& UltimaRiga2).SpecialCells(xlCellTypeVisible).Copy
    NuovoSheet.Range("A1").PasteSpecial xlPasteFormulas

    FoglioTotale.ShowAllData
    FoglioTotale.Range("A1:AO12").Copy
    NuovoSheet.Range("A1:AO12").PasteSpecial xlPasteFormats

    UltimaRiga3 = NuovoSheet.UsedRange.Rows(NuovoSheet.UsedRange.Rows.Count).Row
    NuovoSheet.Range("A12:AO12").Copy
    NuovoSheet.Range("A13:AO"& UltimaRiga3).PasteSpecial xlPasteFormats

    NuovoSheet.Range("A10:AO"& UltimaRiga2).AutoFilter Field:=34, Criteria1:=""
    NuovoSheet.ShowAllData
    NuovoSheet.Range("A1:AO1").EntireColumn.AutoFit
    NuovoSheet.Activate
    ActiveWorkbook.Windows(1).DisplayGridlines = False
    NuovoSheet.Range("AH1").EntireColumn.Hidden = True
    NuovoSheet.Range("K1:V1").EntireColumn.Group
    NuovoSheet.Outline.ShowLevels RowLevels:=0, ColumnLevels:=1

    NuovoWorkbook.SaveAs Filename:=PercorsoSalvataggio & NomeFileAsm & " - "& FoglioParametri.Range("M"& i).Value & ".xlsx"
    NuovoWorkbook.Application.CutCopyMode = False
    NuovoWorkbook.Close False
    FoglioTotale.AutoFilterMode = False

Next i

FoglioParametri.Range("M1").EntireColumn.Delete

FileStatistiche.Application.CutCopyMode = False
FileStatistiche.Close savechanges:=False

MsgBox "Fatto!"

FoglioMacro.Activate

End Sub

Thank you all for your help and time Luca

Can you guys help me to make this code shorter? and smarter i guess

$
0
0

Hi guys I'm a newbie on this so don't expect much from the code. Just tryna to make it shorter. Thanks! The code was made on the recorder macro function and I was cleaning it as much as I could. May be a smarter code for this but, basically is just to divide on 500 from the A column

Columns("A:A").Select
    Application.CutCopyMode = False
    ActiveSheet.Range("A:A").RemoveDuplicates Columns:=1, Header:=xlNo
Range("A501:A1000").Cut
    Range("B:B").Select
    ActiveSheet.Paste
Range("A1001:A1500").Cut
    Range("C:C").Select
    ActiveSheet.Paste
Range("A1501:A2000").Cut
    Range("D:D").Select
    ActiveSheet.Paste
Range("A2001:A2500").Cut
    Range("E:E").Select
    ActiveSheet.Paste
Range("A2501:A3000").Cut
    Range("F:F").Select
    ActiveSheet.Paste
Range("A3001:A3500").Cut
    Range("G:G").Select
    ActiveSheet.Paste
Range("A3501:A4000").Cut
    Range("H:H").Select
    ActiveSheet.Paste
Range("A4001:A4500").Cut
    Range("I:I").Select
    ActiveSheet.Paste
Range("A4501:A5000").Cut
    Range("J:J").Select
    ActiveSheet.Paste
End Sub```

VBA Multiply Last 3 Cells of 2 Columns to be Expandable

$
0
0

I'm trying to multiply 2 values in another worksheet named "DATA" and then multiply 2 more values underneath it. This must be expandable so when more values are added to the spreadhseet, the cells with the calculations update. Those calculations are placed in a worksheet called "Report" in cells C9:C11.

I'm wanting to multiply cell 45 of column B by cell 45 of column C. Then, multiply cell 46 of column B by cell 46 of column C, finally multiply cell 47 of column b by cell 47 of column c.

If new data is added for example another 3 cells to columns B and C, this should update to accommodate the data and multiply those values.

My code which is static:

Range("C9").Select
ActiveCell.FormulaR1C1 = "=DATA!R[30]C[-1]*DATA!R[30]C"
Range("C9").AutoFill Destination:=Range("C9:C11"),  Type:=xlFillDefault

Spreadsheet: https://imgur.com/a/32hXkDk Where calculations should go: https://i.stack.imgur.com/T61IS.png

Code:

Sub HourStraightOnetoTwo()
Dim lRow As Integer
Dim rangex As Range, rangey As Range, rangey2 As Range, rangey3 As Range, rangey4 As Range
Dim rangexMonth As Range, rangeInvNorm As Range, rangeInvFore As Range
Dim srs As Series
Dim ws As Worksheet

' Selects the entirety of column A and formats the date to be in the format of mmm-dd
Columns("A:A").Select
Selection.NumberFormat = "[$-en-US]mmm-yy;@"' Deletes the sheet named Report if it exists
For Each ws In Sheets
    If ws.Name = "Report" Then
        Application.DisplayAlerts = False
        Sheets("Report").Delete
        Application.DisplayAlerts = True
        Exit For
    End If
Next

With Sheets("DATA")
.Activate
' Adds titles to forecast columns
.Range("J1").Value = "Production Forecast"
.Range("K1").Value = "Demand Forecast"
.Range("L1").Value = "Inventory Forecast"' Selects the Last Row
lRow = Worksheets("DATA").Range("B"& Rows.Count).End(xlUp).Row
' Copies the last 3 cells in column 2, Production Units
.Range(.Cells(lRow - 3, 2), .Cells(lRow, 2)).Copy
' Pastes those last 3 cells in column 10, Production Forecast
.Range(.Cells(lRow - 3, 10), .Cells(lRow, 10)).PasteSpecial Paste:=xlPasteValues
' Copies the last 3 cells in column 5, Demand
.Range(.Cells(lRow - 3, 5), .Cells(lRow, 5)).Copy
' Pastes those last 3 cells in column 11, Demand Forecast
.Range(.Cells(lRow - 3, 11), .Cells(lRow, 11)).PasteSpecial Paste:=xlPasteValues
' Calculates Inventory
lRow = .Cells(.Rows.Count, "A").End(xlUp).Row
' Subtracts Production Units from Demand
.Cells(2, "G").FormulaR1C1 = "=RC[-5]-RC[-2]"' Subtracts Production Units from Demand and adds the previous month's Inventory
.Range(.Cells(3, "G"), .Cells(lRow, "G")).FormulaR1C1 = "=RC[-5]-RC[-2]+R[-1]C"' Calculates next 3 months of Inventory - Redundant but needed for how this is coded
.Range(Cells(lRow - 3, 12), Cells(lRow, 12)).FormulaR1C1 = "=RC[-2]-RC[-1]+R[-1]C[-4]"
.Range(Cells(lRow - 2, 12), Cells(lRow, 12)).FormulaR1C1 = "=RC[-2]-RC[-1]+R[-1]C"

End With

' Add the Report worksheet
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Report"
 With Sheets("Report")
.Range("A2") = Now()
.Range("A3").Value = "Dear Madam/Sir,"
.Range("A5").Value = "The following are the projected production, inventory, and total costs for the following"
.Range("A6").Value = "three months."
 End With

Sheets("DATA").Activate
' Use this lRow now since the previous one require you to be in a With loop
Range(Cells(lRow - 2, 1), Cells(lRow, 1)).Copy

' THIS IS A WORK IN PROGRESS
With Sheets("Report")
.Activate
' Pastes the last 3 cells of Column A into the Month column
.Range("B9").PasteSpecial Paste:=xlPasteAll
Columns("A:A").ColumnWidth = 13.71
Columns("C:C").ColumnWidth = 13.71
Columns("D:D").ColumnWidth = 13.71
.Range("B8").Formula = "Month"
.Range("C8").Formula = "Production Cost"
.Range("A14").Formula = "Figure below illustrates the production unit, and the demand time series for the past year;"
.Range("A15").Formula = "as well as the forecast for the following three months."
.Range("A28").Formula = "Figure below illustrates the inventory levels for the past year, as well as the forecast for the"
.Range("A29").Formula = "following three months."
.Range("A41").Formula = "Regards,"
.Range("A42").Formula = "name"
.Range("A43").Formula = "email"' Calculates the Production cost
Range("C9").Select
ActiveCell.FormulaR1C1 = "=DATA!R[30]C[-1]*DATA!R[30]C"
Range("C9").AutoFill Destination:=Range("C9:C11"), Type:=xlFillDefault
' Calculates the Inventory cost
Range("D9").Select
ActiveCell.FormulaR1C1 = "=DATA!R[30]C[3]*DATA!R[30]C"
Range("D9").AutoFill Destination:=Range("D9:D11"), Type:=xlFillDefault
Range("D10").Select
.Range("C14").Select
.Range("D8").Formula = "Inventory Cost"
.Range("E8").Formula = "Total Cost"
.Range("B12").Formula = "Total"' Sums Production Cost for the last 3 months
.Range("C12").Formula = "=SUM(C9:C11)"' Fills in the adjacent cells to the right
.Range("C12").AutoFill Destination:=Range("C12:E12"), Type:=xlFillDefault
' Sums Production and Inventory Cost for one month
.Range("E9").Formula = "=SUM(C9:D9)"' Fills in the cells below
.Range("E9").AutoFill Destination:=Range("E9:E11"), Type:=xlFillDefault
End With

Break python loop when it finds 2 consecutive empty cells

$
0
0

I want to count the rows & columns present in an Excel table using a loop, and the loop should stop running on encountering 2 (or more) consecutive empty cells.

row_count=0
col_count=0

for a in range(1,temp.max_row+1):
   if temp.cell(row=a,column=2).value!=None:
       row_count= row_count+1
   else:
       break
for b in range(2,temp.max_column+1):
   if temp.cell(row=8,column=b).value!=None:
       col_count=col_count+1
   else:
       break
print(row_count)
print(col_count)

However, I cant get a correct result with the method used.

Copying an opened CSV to another existing Workbook

$
0
0

Browse for an select a csv file, open that csv file, copy an entire sheet from that file not working - data is pasting to a new file instead

I want to create VBA code that will allow the user to browse for an select a .csv file, open it, copy an entire sheet from that file (it will have only one sheet in it, always), and paste that entire sheet into a sheet in the primary excel workbook called 'dec'.

Note that I'm not getting an error when the code runs. When I run it, I am able to browse for and select the .csv file. The data appears to be copied. But, it is pasting the data into a new workbook instead of into "This Workbook." And then, my code itself is getting pasted into the tab I designated (the 'dec' tab). I'm obviously doing something dumb ,but I can't see it today.

Sub Get_Data_From_File()
Dim FileToOpen As Variant
Dim OpenBook As Workbook
Application.ScreenUpdating = False
FileToOpen = Application.GetOpenFilename(Title:="Browse for your Stripe download", FileFilter:="csv Files (*.csv*),*csv*")
If FileToOpen <> False Then
Set OpenBook = Application.Workbooks.Open(FileToOpen)
OpenBook.Sheets(1).Copy
ThisWorkbook.Worksheets("dec").PasteSpecial xlPasteValues
OpenBook.Close SaveChanges:=False

End If
Application.ScreenUpdating = True
End Sub

Running stored procedure with VBA

$
0
0

I am trying to make vba code to run stored procedures, but I am keep getting an error at the last line. The error is

"An object or column name is missing or empty. For SELECT INTO statements, verify each column has a name. For other statements, look for empty alias names. Aliases defined as ""or [] are not allowed. Change the alias to a valid name."

Looks like that is telling me I have a syntax error at the last line. How can I fix this error?

 Sub Button_Update()
    'TRUSTED CONNECTION
        On Error GoTo errH
        Dim con As New ADODB.Connection
        Dim rs As New ADODB.Recordset
        Dim strPath As String
        Dim intImportRow As Integer
        Dim CID, LastID As String
        Dim RDate As Variant
        Dim strRecordID As Integer
        Dim server, username, Password, table, database As String


    If MsgBox("Do you want to update this line?", vbYesNo) = vbNo Then Exit Sub

        With Sheets("User Input")

                server = "wesrtednt-prod"
                table = "pr_Load"
                database = "Prod"



                If con.State <> 1 Then

                   con.Open "Provider=SQLOLEDB;Data Source="& server & ";Initial Catalog="& database & ";Integrated Security=SSPI;"'con.Open

                End If
                'this is the TRUSTED connection string

                Set rs.ActiveConnection = con


                'set first row with records to import
                intImportRow = 2

                Do Until .Cells(intImportRow, 1) = ""
                CID= .Cells(intImportRow, 1)
                    RDate = .Cells(intImportRow, 2)
                    LastID= .Cells(intImportRow, 3)

    If RDate = "" Then RDate = Null



    con.Execute "pr_Load'"& CID& "','"& RDate & "'"""

Passing a 2D array as parameter for a sub in VBA

$
0
0

I am doing an Assignment where we have to do a member excel sheet using data obtained from a database

I have declared the Array as

Dim DataArray(10, 10) As Variant

And created a Public Sub

Public Sub FillInInfo(InfoArray() As Variant) //Some code here that uses the data as an Array End Sub

when I try to feed the Sub with the DataArray(i,j) FillInInfo(DataArray) I get an errorenter image description here

Viewing all 88206 articles
Browse latest View live


<script src="https://jsc.adskeeper.com/r/s/rssing.com.1596347.js" async> </script>